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PREFACE 


This  work  was  supported  by  the  Calibration  Coordination 
Group,  project  number  276,  for  the  Army  Primary  Standards 
Laboratory  at  the  Redstone  Arsenal,  Alabama. 

We  use  trade  names  to  specify  the  equipment  used  in  this 
system.  No  endorsement  by  the  National  Institute  of  Standards 
and  Technology  is  implied.  Similar  products  by  other 
manufacturers  may  work  as  well  or  better. 
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1.0  INTRODUCTION 


1.1  General 

The  Automatic  Waveform  Analysis  and  Measurement  System 
(AWAMS)  is  a system  used  at  the  National  Institute  of  Standards 
and  Technology  (NIST)  to  obtain  measurements  of  electrical  pulses 
that  have  transients  ranging  from  10  nanoseconds  (ns)  to  20 
picoseconds  (ps)  and  to  analyze  these  measurement  data  to  obtain 
pulse  parameters,  such  as  transition  duration  (rise  and  fall 
time) , pulse  aberration  (overshoot  and  undershoot) , pulse 
amplitude  (topline  minus  baseline) , pulse  duration  (pulse  width) , 
etc.  The  AWAMS  was  constructed  for  the  Calibration  Coordination 
Group  (CCG) , project  number  276,  by  NIST. 

1.1  Overview  of  The  Manual 

The  remainder  of  the  User's  Manual  provides  the  information 
necessary  to  operate  the  AWAMS.  Section  2 includes  a brief 
review  of  pertinent  technical  information,  such  as  the  theory  of 
deconvolution.  Sections  3 and  4 describe  the  hardware  and 
software  components  of  the  AWAMS  and  their  operation.  In  Section 
5,  we  give  warnings  and  considerations  on  the  use  of  the  AWAMS. 
Section  6 contains  references  to  related  technical  papers, 

Section  7 a glossary  of  terms,  and  Section  9 a specifications 
list,  manufacturers  users'  manuals  list,  and  example  measurement 
procedures.  Section  10  contains  the  software  source  code 
listings . 
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2.0  BACKGROUND 


2 c 1 General 

The  AWAMS  uses  an  equivalent-time  sampling  oscilloscope  to 
acquire  discrete-time  data  that  will  represent  a periodic 
continuous-time  waveform.  Before  sampling  the  waveform,  however, 
the  sampling  oscilloscope  must  be  readied.  Readiness  is  provided 
by  triggering  the  oscilloscope  before  the  waveform  arrives  at  the 
oscilloscope's  sampling  gate.  Only  one  sample  point  on  the 
waveform  is  taken  after  each  trigger  event.  The  next  point  along 
the  waveform  is  obtained  by  adding  a small  delay  between  trigger 
and  waveform  arrival.  The  entire  waveform  is  then  mapped  by 
successively  increasing  this  delay  for  each  subsequent  point.  To 
get  an  accurate  representation  of  the  waveform,  the  time  interval 
between  trigger  and  waveform  arrival  must  not  vary  randomly.  In 
reality,  however,  this  time  interval  does  vary  randomly;  this 
random  variation  between  the  time  of  arrival  of  the  waveform  and 
its  trigger  is  called  jitter.  The  effect  of  jitter  is  to  smooth 
the  data,  as  would  be  done  by  a filter.  This  smoothing  of  the 
data  is  described  mathematically  by  the  convolution  of  the  filter 
with  the  data. 

The  AWAMS  provides  a mechanism  (deconvolution)  for  removing 
the  effect  of  jitter  on  the  acquired  data  so  that  a more  accurate 
representation  of  the  input  waveform  is  obtained.  In  addition, 
the  effect  of  the  oscilloscope's  sampling  aperture  is  also 
removed,  as  are  the  effects  of  time  and  voltage  errors.  In 
Section  2.2,  we  provide  a review  of  sampling  theory,  and  review 
the  convolution  and  deconvolution  processes  in  Section  2.3.  We 
describe  the  time  and  voltage  calibration  procedures  in  Sections 
2.4  and  2.5,  and  describe  the  pulse  parameter  calculations  in 
Section  2.6. 


2 


2.2  Sampling 


The  effect  of  equivalent-time  sampling  on  a continuous 
function  of  time  is  to  discretize  the  time  over  which  the 
function  is  defined.  For  example,  if  a continuous  function 
(corresponding  to  some  real  signal)  is  sampled  once  every  second, 
then  the  discretized  replica  of  the  continuous  function  has 
information  only  at  each  1 s interval.  This  can  be  written  as 

gm  = g (me) , o <;  m <.  « , (l) 

where  m is  an  integer,  e is  the  time  interval  between  samplings, 
g(me)  is  g(t)  defined  only  at  t = me , g(t)  is  the  continuous 
function,  and  gm  is  the  discretized  replica  of  g(me) . In  eq  (1) , 
it  is  assumed  g(t)  does  not  exist  before  t = 0.  Equation  (1)  may 
also  be  written,  in  a more  useful  form  [1],  as  the  product  of  a 
continuous  function  with  a periodically  spaced  delta  function 
S(t)  t 

oe 

gm  = g(  t)  6 (t-me)  . (2) 

fll  = 0 


Recall  that  <S(t-a)  = 1 when  t-a  = 0 and  is  0 otherwise.  It  is 
worthwhile  to  examine  the  frequency  representation  of  eq  (2) ; 
this  is  done  using  the  Fourier  transform.  The  Fourier  transform 
of  the  summation  in  eq  (2)  becomes  [2]s 


FT 


« 

E 

m = 0 


6 ( t -me) 


(2n/e)  5 ( t-kf3)  , 


(3) 


where  k is  an  integer,  FT  denotes  a Fourier  transform  operation, 
and  fs  = 2 n/e  is  the  frequency  corresponding  to  the  sampling 
interval.  The  Fourier  transform  of  g(t)  is  simply  (l/27r)G(f). 

By  an  identity  of  Fourier  transforms,  the  point-by-point 
multiplication  of  two  functions  in  one  domain  becomes  the 
convolution  of  the  Fourier  transforms  of  the  two  functions  in  the 
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transform  domain.  Accordingly,  the  frequency  representation  of 
eq  (2)  is 

CD 

Gk  - (l/e)  Gif)  * Y,  8 (f-kfs)  , (4) 

k~  -« 

where  * denotes  a convolution  and  Gk  is  the  discrete  Fourier 
transform  of  gm.  Another  property  of  Fourier  transforms  is  that 
the  Fourier  transform  of  a real-valued  waveform  is  Hermitian; 
that  is,  G*(-f)  = G ( f ) . Therefore,  | G* ( — f ) | = |G(f)|.  (The 
superscript  * denotes  a complex  conjugate,  and  the  vertical  bars 
indicate  absolute  values.)  Let  fN  be  the  band-limiting  frequency 
of  G ( f ) ; that  is,  fN  is  the  highest  frequency  having  information 
on  g(t) . Because  G(f)  is  Hermitian,  | G ( f ) | is  symmetric  about 
f ~ 0 and  has  information  from  f„N  to  fN.  Examination  of  eq  (4) 
shows  that  fs  must  be  greater  than  2fN  to  avoid  overlap  between 
replicas  of  G(f)  that  are  centered  at  adjacent  kfs  values.  This, 
then,  is  the  sampling  criterion:  the  sampling  frequency  must  be 
at  least  twice  the  highest  frequency  that  contains  information  on 
the  input  waveform.  Accordingly,  the  waveform  must  not  have 
faster  transients  than  the  sampling  period. 

2.3  Deconvolution 

This  section  is  taken  from  Ref.  [3].  Data  acquired  from  the 
measurement  of  a given  signal  are  affected  by  the  necessary 
intervention  of  the  measuring  device  (such  as  measuring  an 
electrical  pulse  with  an  oscilloscope) . These  data  represent  the 
signal  as  viewed  by  the  measurement  instrument  and,  therefore, 
can  be  described  by  the  convolution  of  the  instrument's  impulse 
response  with  the  signal.  Consequently,  it  is  necessary  to 
remove  the  effects  of  the  instrument  on  the  data  to  get  a more 
accurate  representation  of  the  signal;  this  is  done  by 
deconvolution.  Discrete  convolution  is  described  by 
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(5) 


N-l 


53  ' 


where,  for  illustration,  gm  is  a measurable  characteristic  of  an 
event  under  investigation,  is  the  impulse  response  of  the 
measurement  system,  fT  is  the  acquired  signal,  m is  the  time 
index,  N is  the  number  of  points  in  the  record,  and  r is  the 
delay.  The  frequency  domain  equivalent  of  eq  (5)  is 


where  k is  the  frequency  index  and  the  functions  Fk,  Gk,  and  Hk 
are  the  discrete  Fourier  transforms  of  the  time  functions  given 
in  eq  (5) . Typically,  deconvolution  is  done  with  the  discrete 
Fourier  transformation  (DFT)  of  the  data  and  instrument  response 
and,  therefore,  assumes  periodicity  of  the  data.  Consequently, 
if  the  waveform  is  step-like  (a  step-like  waveform  is  a waveform 
that  has  zero  or  nearly  zero  slope  at  either  end  of  the  record, 
and  the  nominal  values  at  the  ends  of  the  record  are  not  the 
same)  the  abrupt  end  of  the  record  will  cause  oscillations  in  the 
record  of  the  deconvolved  data.  This  phenomenon  is  expected 
because  the  abrupt  transition  is  artificial.  Therefore,  in  order 
to  perform  deconvolution  using  step-like  waveforms,  the  record's 
truncation  discontinuities  must  be  dealt  with  properly.  The 
procedure  used  at  NIST  to  minimize  the  record  truncation 
discontinuity  in  step-like  waveforms  is  the  Nahman-Gans  record- 
extension  technique  [4].  Other  techniques  that  may  minimize 
errors  and  decrease  computation  time  are  presently  under 
investigation.  In  the  frequency  domain,  the  deconvolution 
becomes  a division  of  the  spectra, 


and  gm  is  recovered  by  doing  an  inverse  Fourier  transform  of  Gk. 


Fk  = GkHk  , 0 £ k Z N- 1 


(6) 


(7) 
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Equation  (5)  represents  a linear  convolution  process  whereas 
eq  (6)  represents  a cyclic  convolution  process.  The  two  processes 
provide  the  same  result  as  long  as  time-aliasing  in  the  cyclic 
process  is  prevented  [1].  For  the  waveforms  used  here,  eq  (5) 
and  (6)  will  give  equivalent  results. 

If  the  impulse  response  is  not  known  exactly,  only  an 
approximate  solution  or  best  guess  can  be  found  to  the 
deconvolution.  The  deconvolution  is  called  "blind"  when  Gk  and 
Hk  of  (6)  are  not  known  exactly.  Furthermore,  more  than  one 
possible  solution  may  exist  for  the  blind  deconvolution,  and  the 
best  solution  must  be  selected.  For  example,  when  an  electrical 
waveform  is  measured  with  an  oscilloscope,  the  oscilloscope's 
impulse  response  is  usually  not  known  but  is  approximated. 
Consequently,  either  the  data  may  be  accepted  as  a true 
representation  of  the  input  signal  or  deconvolution  attempted 
with  an  approximate  impulse  response  and  the  dubious  results 
accepted. 

The  ability  to  solve  the  blind  deconvolution  problem  and 
obtain  an  accurate  approximation  to  the  signal  is  very  important, 
especially  when  the  instrument  has  a large  effect  on  the  signal. 
(Actually,  blind  deconvolution  is  not  solved;  only  the  best-guess 
solution  is  obtained.)  The  best-guess  solution  to  the  blind 
deconvolution  problem  is  obtained  by  iterative  techniques.  The 
iterations  continue  until  a change  in  a predetermined  waveform 
attribute  occurs.  This  attribute  change  is  used  as  an  indicator 
of  the  stability  of  the  solution  and  is  called  the  stopping 
criterion.  The  change  in  the  waveform  attribute  is  caused  by 
varying  a parameter  used  in  the  iterative  deconvolution.  The 
technique  presently  used  by  NIST  to  solve  the  blind  deconvolution 
is  a matched-filter  technique  using  a variable  parameter  we  call 
F [ 5 ] . The  filter  is  a low-pass  filter,  and  F is  related  to  the 
roll-off  frequency.  The  filtering  is  applied  to  frequency  domain 
deconvolution  to  suppress  the  noise  that  results  by  performing 
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deconvolution  for  frequencies  where  there  is  no  appreciable 
spectral  content  in  Hk.  The  stopping  criterion  presently  in  use 
is  the  minimum  in  the  power  of  the  imaginary  part  of  the 
reconstructed  record.  This  power  is  given  by 

Pi  = T,  <8> 

m=o 

Other  filtering  techniques  and  stopping  criteria  that  may  provide 
better  results  and  shorten  processing  time  are  being 
investigated . 

2.4  Time  Calibration 

The  time,  or  horizontal,  axis  calibration  is  performed  by 
putting  a single-frequency  sinusoidal  waveform  into  the 
oscilloscope.  The  zero  crossings  of  the  sine  wave  are  used  to 
calibrate  the  time  axis.  The  zero  crossings  are  used  because 
they  provide  the  most  robust  sine-wave  parameter  in  terms  of 
resistance  to  noise,  amplitude  fluctuations,  and  jitter.  Once 
the  locations  of  the  zero  crossings  are  determined,  the  time  axis 
can  be  calibrated.  For  example,  consider  using  a 10-GHz  sine 
wave  to  calibrate  a 1-ns  window  that  is  defined  over  1000  points. 
The  zero  crossings  should  be  50  points,  or  0.05  ns,  apart.  If 
they  are  not  for  any  region  between  a pair  of  adjacent  zero- 
crossings,  the  time  values  are  corrected  in  that  region.  Once 
the  time  axis  is  corrected,  the  data  are  linearly  interpolated  so 
that  their  new  values  coincide  with  their  new  time. 


7 


2.5  Voltage  Calibration 


The  voltage  calibration  routine  is  a steady-state  technique. 
A known  dc  voltage  is  applied  across  the  terminals  (center  and 
ground)  of  the  sampling  head's  input  port,  and  the  voltage 
measured  by  the  oscilloscope  is  recorded.  After  performing 
multiple  measurments  of  this  type,  a relationship  between  the 
actual  and  measured  voltages  is  obtained.  This  relationship  can 
be  imagined  as  a plot  of  the  actual  versus  measured  voltages. 

The  slope  of  this  plot  is  used  to  correct  the  voltage  values  of 
the  acquired  data.  Consider  an  example  where  the  measured 
voltage  equals  0.9  times  the  actual  voltage.  The  new  data  will  be 
Vc  = V/0.9,  where  Vc  is  the  corrected  value  and  V is  the  acquired 
value. 


2.6  Pulse  Parameter  Calculation 

The  purpose  of  measuring  a pulse  waveform  is  to  calculate 
the  values  of  the  parameters  that  describe  the  waveform  features. 
The  parameters  calculated  by  the  pulse  parameters  program  are: 
pulse  amplitude,  pulse  transition  duration,  overshoot,  and 
undershoot.  We  use  a histogram-based  algorithm  for  pulse 
parameter  determination.  The  histogram  represents  a distribution 
function  of  the  y-axis,  usually  voltage,  values.  The  pulse 
parameters  are  defined  in  the  ANSI/IEEE  (American  National 
Standards  Institute/Institute  of  Electrical  and  Electronics 
Engineers)  Std  194-1977  [6],  and  the  algorithms  we  use  for 
calculation  of  the  pulse  parameters  are  based  on  the  IEEE  Std 
181-1977  [7]. 
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3.0  HARDWARE  SYSTEM  DESCRIPTION 


3 . 1 General 

The  AWAMS  hardware  system  consists  of  an  digitizing 
oscilloscope,  a computer  controller,  and  computer  peripheral 
devices  that  are  linked  by  an  IEEE  488  bus  interface.  A block 
diagram  of  the  hardware  system  is  shown  in  Fig.  1.  Descriptions 
of  the  hardware  used  in  the  AWAMS  are  found  in  the  manuf actuers ' 
users'  manuals.  A list  of  these  documents  is  found  in  Appendix 
A;  refer  to  these  manuals  for  specifications,  operation 
procedures  and  safety  information.  References  to  these  manuals 
will  be  indicated  by  [MUD  {A}],  where  A is  the  document  number. 


COMPUTER 


Figure  1.  Diagram  of  AWAMS  hardware  system. 
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4.0  SOFTWARE  SYSTEM  DESCRIPTION 


4 . 1 General 

The  following  programs  are  included  in  the  AWAMS  packages 

1.  ACQUIRE:  a data  acquisition  routine  that  allows 
for  acquisition  of  calibration  data  and  waveform 
data. 

2.  FIXACQ:  a utility  to  alter  the  waveform  according 
to  the  calibration  data. 

3.  DECON_NIST:  a deconvolution  routine. 

4.  GAUSS:  a Gaussian  waveform  generator  that  creates 
a waveform  to  approximate  the  distribution 
function  of  the  jitter  of  the  measurement  system. 
This  function  may  be  deconvolved  from  the  waveform 
data. 

5.  PULS_PARAMS:  a pulse  parameters  calculation 
program. 

6.  MATH_J3PS : a vector  utilities  program  that  performs 
waveform  mathematical  operations.  And, 

7.  text_out:  a program  that  prints  the  ASCII  file 
generated  by  PULS_P ARAMS. 

These  programs  must  be  loaded  into  the  computer  before  they 
are  run.  The  BASIC  language  is  case  sensitive;  therefore,  type 
the  names  exactly  as  shown  above  when  you  load  the  programs.  A 
more  detailed  description  of  each  program  is  provided  in  Sections 

4.2  through  4.6,  including  menu  descriptions  or  flow  charts  and 
written  descriptions.  Program  details  can  be  found  in  the 
following  text  or  in  the  source  code  listings. 

A version  of  GRAPH_OATA,  the  graphics  support  program 
developed  at  NIST  is  provided.  No  documentation  for  GRAPH_DATA 
is  included  in  this  manual. 
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Error  checking  is  included  in  the  AWAMS  software.  If  you 
hear  a beep  or  series  of  beeps  after  running  a program,  pay 
attention  to  the  message  displayed  on  the  screen.  The  beeps  are 
alerting  you  to  the  presence  of  an  error  message.  This  message 
will  let  you  know  what  went  wrong. 


4.2  Data  Acquisition  — (ACQUIRE) 

There  are  four  measurements  required  for  testing  a pulse: 
the  device  under  test  (DUT)  measurement,  the  voltage  calibration 
measurement,  the  time  calibration  measurement,  and  a jitter 
measurement.  The  jitter  measurement  is  an  estimate  of  the  time 
jitter  in  the  DUT  and  measurement  system  [8]  and  is  a single 
point  measurement,  described  in  the  Appendix  (A. 4. 4).  With  the 
exception  of  the  jitter  measurement,  all  measurements  require  the 
acquisition  of  digitized  waveforms. 

The  acquisition  program  acquires  the  DUT  waveform  data,  the 
voltage  calibration  data,  and  the  time  calibration  data.  This 
program  is  menu  driven.  Menu  selections  are  made  using  simple  on- 
screen graphics  and  the  "softkeys."  The  main  menu  (softkeys) 
allows  for  the  selection  of  any  of  the  following:  the  waveform 
acquisition  menu,  the  voltage  calibration  menu,  the  time 
calibration  menu,  and  program  information  (see  Fig.  2) . Table  1 
gives  a brief  description  of  the  softkey  options.  No  attempt  was 
made  to  fully  automate  the  front  panel  operation  of  the 
oscilloscope;  therefore,  many  oscilloscope  operations  can  only  be 
performed  manually. 

The  first  time  you  enter  any  of  the  menus  the  acquisition 
program's  user-definable  parameters  are  preset  to  default  values. 
When  you  change  any  parameter  value,  the  system  will  retain  the 
new  values,  as  long  as  the  program  is  in  active  memory  (RAM) , 
even  if  you  move  from  menu  to  menu. 
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Figure  2.  Softkey  menu  for  the  data 
acquisition  program  ACQUIRE. 

There  are  oscilloscope  settings  that  are  not  retained  in 
memory.  Any  setup  parameter  not  available  in  any  menu  will  not 
be  remembered  when  you  change  measurement  menus.  For  example,  if 
you  use  the  oscilloscope's  internal  step  generator  as  the  input 
signal  to  a device,  as  in  time-domain  ref lectometry  (TDR) , the 
step  generator  is  turned  off  when  you  change  to  any  other  menu. 
The  oscilloscope  is  reset  every  time  you  move  from  one  menu  to 
another  to  prevent  the  oscilloscope  from  being  in  an  unknown 
state.  However,  to  use  the  step  generator  as  the  input  signal, 
use  the  manual  setup  feature  of  the  acquisition  program,  which  we 
describe  later  in  this  document,  to  turn  on  the  step  generator 
and  view  the  waveform.  Then  use  the  "save  setup"  feature  of  the 
oscilloscope  to  retain  this  configuration  [MUD  {1}].  Acquire  the 


12 


Table  1.  Softkey  options  for  the  ACQUIRE  program. 


CHOICE 

FUNCTION 

Main  Menu 

Returns  the  program  from  current  menu. 

Exit  Program 

Quits  the  Acquire  program. 

Acquire  Data 

Causes  the  oscilloscope  to  take  the  data. 
The  oscilloscope  takes  control  of  the  bus 
during  acquisition,  but  the  "ABORT"  key  can 
be  used  to  interrupt  the  acquisition. 

Change  Value 

Allows  for  changes  of  the  on-screen 
parameters.  See  the  Tables  on  screen  menu 
choices. 

Manual  Setup 

Waveform:  Allows  for  front  panel  operation 
of  the  oscilloscope.  May  change  any 
parameter  values  and  the  new  value  will  be 
maintained  when  the  program  is  continued. 

TCAL/VCAL:  Allows  for  front  panel  operation 
of  the  oscilloscope.  The  values  of  menu 
items,  such  as  points,  averages,  etc., 
cannot  be  changed  using  this  option.  Other 
items,  such  as  the  trigger  slope,  that  are 
not  included  in  the  ACQUIRE  program's  menu 
selection  will  change  using  this  feature. 
The  manual  setup  key  is  most  useful  for 
determining  calibration  of  waveform  details 
like  establishing  the  length  of  the  delay 
line  in  the  TCAL  trigger  circuit  that  is 
used  to  correctly  place  the  signal  in  time. 

data  normally  and  then  acquire  the  time  and  voltage  calibration 
data.  When  you  want  to  acquire  another  set  of  data  using  the 
step  generator,  return  to  the  waveform  menu,  use  the  manual  setup 
key,  recall  the  saved  setup  and  then  continue  with  the 
measurement.  By  using  the  save  and  recall  features,  the 
oscilloscope's  parameters  will  be  restored  to  the  same  parameters 
used  in  the  previous  measurement. 


The  parameters,  in  every  menu,  have  error  checking.  You 
change  some  of  the  parameters  in  their  own  menus.  Other 
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parameters  are  changed  by  toggling.  Each  of  these  provides  error 
checking  by  limiting  your  alternatives  to  those  values  that  the 
oscilloscope  can  provide.  However,  there  are  some  parameters 
that  are  checked  only  for  the  value  of  the  numeric  input  that 
make  sense  for  the  parameter.  It  is  possible  to  input  a value 
that  the  oscilloscope  cannot  accommodate;  then  the  oscilloscope 
will  default  to  the  closest  value  it  can  provide.  This  is  the 
only  time  there  could  be  an  inconsistency  between  the  screen 
display  and  the  acquired  data.  An  error  message  will  appear  for 
a short  time  on  the  oscilloscope  screen.  Familiarity  with  the 
operation  of  the  oscilloscope  will  help  to  prevent  these  errors. 

In  addition  to  error  checking  of  the  data,  this  program 
checks  for  a response  from  the  oscilloscope,  an  external  trigger, 
and  the  internal  step  generator.  These  checks  prevent  the 
attempted  acquisition  of  waveform  data  from  an  oscilloscope  that 
is  off  or  from  an  oscilloscope  that  is  on,  but  does  not  have  a 
signal  input  into  one  of  the  test  channels.  The  check  for  the 
existence  of  a waveform  does  not  verify  the  sampling  channel 
selection. 

4.2.1  Waveform  menu 

First  we  describe  the  waveform  menu  (see  Fig.  3) . The 
parameters  available  in  this  menu  are: 

1.  the  channel  for  acquisition; 

2.  volts  per  division  or  vertical  sensitivity; 

3.  offset  or  vertical  position  control; 

4.  attenuation,  this  facilitates  the  use  of  attenuator 

probes ; 

5.  time  per  division  or  horizontal  sensitivity; 

6.  delay  or  horizontal  position  control; 

7.  delay  reference,  either  center  or  left  side  of  the 

screen; 

8.  number  of  points  to  acquire  in  the  waveform; 
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- CHANNEL 

- VOLT/DIV 

- OFFSET 

- ATTENUATION 

- TIME/DIV 

- DELAY 

- DELAY  REF. 

- # OF  AVERAGES 

- # OF  POINTS 

- TIRGGER  LEVEL 


Figure  3.  Waveform  menu  of  the  acquisition  program. 


9.  number  of  averages  used  to  re-create  the  waveform;  and 

10.  trigger  level. 

The  oscilloscope  user  manuals  can  provide  more  information  on 
about  these  parameters,  see  [MUD  {1}]  and  [MUD{2}]. 

You  may  select  any  one  of  the  above  parameters  with  the 
highlight  box.  The  highlight  box  can  be  moved  using  the  arrow 
keys,  space  bar,  or  knob.  Table  2 gives  a brief  summary  of  the 
effect  of  changing  each  parameter  and  whether  the  values  are 
changed  from  a menu,  input  by  the  operator,  or  toggled. 

You  can  change  the  value  of  the  selected  parameter  by  using 
the  softkey  (at  the  bottom  of  the  screen)  marked  "Change  Value." 
Depending  upon  the  parameter  selected  when  you  press  the  "Change 
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Value"  key,  you  will  be  prompted  to  input  a value,  to  make  a 
selection  from  another  menu,  or  the  "Change  Value"  key  will  cause 
the  parameter  to  toggle  between  two  possible  values. 

You  will  choose  most  of  the  parameter  values,  such  as:  volts 
per  division,  offset,  and  trigger  level  based  on  the  DUT 
waveform.  For  example,  the  offset  is  chosen  to  center  the 
waveform  on  the  oscilloscope  screen  and  the  trigger  level  is 
chosen  for  the  most  nearly  jitter-free  waveform.  You  will  select 
other  parameter  values  for  more  subjective  reasons.  For  example, 
increasing  the  number  of  averages  taken  during  a measurement 
decreases  the  noise  in  the  result.  Another  example,  the  number 
of  points  selected  is  based  on  the  resolution  you  require.  The 
trade-off  for  a larger  number  of  averages  and/or  a larger  number 
of  points  is  acquisition  time.  Generally,  we  recommend  selecting 
the  highest  available  number  of  averages  and  points.  The  only 
instance  when  a large  acquisition  time  is  detrimental  to  the 
measurement  is  when  the  waveform  drifts.  However,  if  the 
waveform  drift  is  significant,  a high  quality  measurement  is  not 
possible  under  any  circumstance. 
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Table  2.  Waveform  screen  menu  selections. 


SELECTION 

FUNCTION 

HOW  TO  CHANGE 

Channel  Number 

Selects  a channel 
for  acguisition. 

Keyboard  input . 
Range:  1 to  4 . 

Volts  per  Division 

Changes  oscilloscope 
display  vertical 
resolution. 

Keyboard  input 
Range:  1 to  80  mV 

Offset 

Changes  the  vertical 
placement  of  the 
waveform  trace — used 
to  correct  a dc 
offset. 

Keyboard  input . 
Range : 

± 500  mV 

Attenuation 

See  description  and 
warnings,  Secs.  5-3 
Ref.  [6]. 

Keyboard  input. 
Range:  1 to  1000 

Time  per  Division 

Changes  oscilloscope 
display  horizontal 
resolution. 

Keyboard  input . 
Range:  10  ps  to  1 s 

Delay 

Controls  the  time 
position  of  the 
waveform. 

Keyboard  input. 
Options  are  time- 
window  dependent. 

Delay  Ref 

Selects  position 
(center  or  left  side 
of  screen) . 

Toggle. 

Number  of  Averages 

Changes  number  of 
averages  used  to 
acquire  waveform. 

Menu.  1 to  2048, 
in  steps  of  powers 
of  2 . 

Trigger  Level 

Changes  oscilloscope 
trigger  level. 

Keyboard  input. 
Range:  ± 1 V 

In  addition  to  the  screen  menu,  the  waveform  menu  also 
includes  the  following  softkey  options: 

1.  exit  to  "Main  Menu," 

2.  "Exit  Program," 

3.  "Acguire  Data," 

4.  "Manual  Setup,"  and 
5 e "Change  Value." 
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We  described  the  "Change  Value"  key  above.  The  "Exit 
Program"  and  "Main  Menu"  keys  are  self-explanatory.  The  "Exit 
Program"  key  must  be  pressed  to  quit  the  program. 

The  "Manual  Set"  option  allows  you  to  use  the  front  panel 
input  keys  to  adjust  the  oscilloscope.  After  modifying  the 
measurement  setup,  press  the  "Continue"  key  to  resume  the 
program.  The  "Continue"  key  is  either  a softkey  that  appears  on 
the  screen,  or  a hard  key  on  the  keyboard.  When  the  "Continue" 
key  is  pressed,  all  of  the  screen  options  are  updated  to  the 
values  chosen  while  in  manual  mode  and  the  oscilloscope  is 
returned  to  the  remote  mode.  Be  aware  that  changes  made  to 
parameters  that  are  not  included  in  the  on-screen  menu  will  need 
to  be  reset  if  you  leave  and  then  return  to  the  waveform  menu. 

Selecting  the  "Acquire  Data"  key  will  reset  the  oscilloscope 
to  the  waveform  parameters  displayed  on  the  screen,  acquire  the 
data,  and  send  the  data  to  the  computer  for  storage.  The  data  are 
stored  in  a format  compatible  with  GRAPH_DATA . The  oscilloscope 
will  assume  control  of  the  IEEE-488  bus  during  the  acquisition 
operation. 

There  is  an  "Abort"  softkey  available  during  acquisition. 
This  option  may  be  selected  if  you  need  computer  control  or  if  a 
parameter  was  incorrectly  selected.  When  you  select  the  "Abort" 
key,  the  measurement  stops,  the  oscilloscope  is  reset,  control  of 
the  bus  is  returned  to  the  computer,  and  the  program  returns  to 
the  waveform  menu. 

4.2.2  Time-calibration  menu 

The  second  menu  we  describe  is  the  time-calibration  or 
"Teal"  menu  (see  Fig.  4)  that  is  used  to  acquire  the  time-base 
calibration  data.  This  menu  is  very  similar  to  the  waveform- 
acquisition  menu,  but  it  contains  only  those  parameters  that  are 
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- FREQUENCY 

- VOLT/DIV 

- OFFSET 

- SAVE  THE  WAVEFORM 

- CALIBRATE  ON 

- POINT  PAIRS  FOR  LEAST  SQAURES  FIT 

- # OF  AVERAGES 

• POINTS  TO  USE  FOR  MOVING  AVERAGE 

- TRIGGER  LEVEL 


Figure  4.  TCAL  menu  of  the  acquisition  program. 

pertinent  to  time-base  calibration  and  allows  changes  to  those 
parameters  that  will  not  compromise  the  consistency  of  the  data 
set.  The  time  calibration  screen  choices  are: 

1.  calibration  frequency  (the  frequency  of  your  time 
standard) ; 

2.  number  of  averages  for  acquisition; 

3.  volts  per  division; 

4.  offset; 

5.  the  number  of  points  for  the  sliding  average  noise 
filter; 

6.  the  number  of  points  for  the  linear  least  squares  fit 
(for  finding  the  zero  crossings  of  the  calibration 
waveform) ; 

7.  the  slope  (positive  or  negative)  to  calibrate  on; 
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8. 


whether  or  not  to  save  the  waveform  from  which  the 
time-calibration  data  are  derived  (this  is  generally  a 
sine-wave) ; and 

9.  the  trigger  level  for  the  time  standard. 

As  with  the  waveform  menu,  you  can  select  the  above 
parameters  by  using  the  arrow  keys,  space  bar  or  knob  and  the 
highlight  box.  When  you  press  the  "Change  Value"  key,  you  will  be 
prompted  to  input  a value,  to  make  a selection  from  another  menu, 
or  the  "Change  Value"  key  will  cause  the  parameter  to  toggle 
between  two  choices.  Again,  the  behavior  of  the  "Change  Value" 
key  depends  on  the  selected  parameter.  Table  3 gives  a brief 
summary  of  the  effect  of  changing  each  parameter  and  whether  the 
values  are  changed  from  a menu,  input  by  the  operator,  or 
toggled „ 

The  time  calibration  menu  also  includes  the  following 
softkey  choices: 

1.  exit  to  "Main  Menu," 

2.  "Exit  Program," 

3.  "Acquire  Data," 

4.  "Manual  Set,"  and 

5.  "Change  Value . " 

With  the  exception  of  the  "Manual  Set"  key,  these  softkeys  work 
as  described  in  the  waveform  menu  section.  The  "Manual  Set"  key 
in  the  time  calibration  menu  is  available  to  facilitate  the  setup 
of  the  time  calibration  waveform  in  the  epoch.  With  this 
feature,  you  can  reposition  the  calibration  waveform  with 
external  delay  line(s) , usually  inserted  in  the  trigger  circuit, 
and  quickly  see  the  effect  of  the  added  delay  line.  If  you 
change  the  parameter  values  while  in  the  manual  mode,  none  of  the 
changed  values  are  read  into  the  acquisition  program.  All 
changed  settings  are  ignored  when  you  return  to  the  program  from 
"Manual  Set."  This  feature  provides  a fast  and  convenient  way 
for  you  to  determine  the  optimal  physical  setup  and  built-in 
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Table  3.  TCAL  screen  menu  selections. 


SELECTION 

FUNCTION 

HOW  TO  CHANGE 

Calibration 

Frequency 

Establishes  the 
frequency  for  time 
calibration. 

Keyboard  input . 
Depends  on  time 
calibration 
standard  used. 

Number  of  Averages 

Changes  number  of 
averages  used  to 
acquire  waveform. 

Menu.  1 to  2048 
in  steps  of 
powers  of  2 . 

Volts  per  Division 

Changes  oscilloscope 
display  vertical 
resolution. 

Keyboard  input . 
Range:  1 to  80 
mV. 

Offset 

Changes  the  vertical 
placement  of  the 
waveform  trace. 

Keyboard  input. 
Range:  ± 500  mV 

Number  of  Points  for 
Sliding  Average 
Filter 

Used  to  filter  noise 
and  find  voltage 
crossings. 

Keyboard  input . 

Number  of  Points  for 
Least  Squares  Fit 

Used  to  find  the 
time  of  the  zero 
crossings. 

Keyboard  input . 

Slope 

Used  to  find  the 
time  of  the  zero 
crossings . 

Toggle:  +/- 

Save  the  Time 
Calibration  Waveform 

Save  time- 

calibration  waveform 
data. 

Toggle:  yes/no 

Trigger  Level 

Changes  oscilloscope 
trigger  level. 

Keyboard  input . 
Range:  ± 1 V. 

protection  against  acquiring  inconsistent  data.  You  must  acquire 
the  time  calibration  data  using  the  same  time/division  and  delay 
settings  as  the  DUT  data.  If  not,  the  epoch  for  the  DUT  will  not 
be  the  same  as  the  calibrated  epoch  and  the  data  set  will  be 
useless.  For  more  details  on  establishing  the  time  calibration 
setup,  see  Sections  A. 4. 2 and  A. 4. 3 of  this  manual. 
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4.2.3  Voltage-calibration  menu 


The  last  menu  available  in  the  acquisition  program  is  the 
"Veal1*  or  voltage-calibration  menu  (see  Fig.  5) . This  is  the 
simplest  menu  in  the  program  with  only  four  screen  options  and 
five  softkey  options. 

The  four  screen  options  are: 

1.  number  of  voltage  intervals  to  measure; 

2.  the  number  of  averages  wanted  for  the  acquisition; 

3.  the  starting  calibration  voltage  value;  and 

4.  the  step  size  of  the  calibration  voltage  increments. 


- # OF  VOLTAGE  INTERVALS 

- VOLTAGE  STEP  SIZE  (VOLTS) 

- NUMBER  OF  AVERAGES 

- MINIMUM  CALIBRATION  VOLTAGE  (VOLTS) 


Figure  5.  VCAL  menu  of  the  acquisition  program. 
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Table  4.  VCAL  screen  menu  selections. 


SELECTION 

FUNCTION 

HOW  TO 
CHANGE 

Number  of  Voltage 
Levels 

To  set  the  voltage  range 
for  calibration,  used  with 
Step  size. 

Keyboard 
input. 
Range:  >0 

Averages 

See  waveform  menu. 

Menu. 

Starting 

Calibration  Voltage 

To  set  starting  value  that 
is  used  to  calibrate  data. 

Keyboard. 
Values 
depend  on 
voltage 
standard. 

Step  Size 

To  set  the  voltage 
increment  for  calibration. 

Keyboard. 
Values 
depend  on 
voltage 
standard. 

As  with  the  waveform  and  time-calibration  menus,  you  may 
select  these  parameters  by  using  the  highlight  box.  Table  4 
gives  a brief  summary  of  the  effect  of  changing  each  parameter 
and  whether  the  values  are  changed  from  a menu,  input  by  the 
operator,  or  toggled. 


The  five  softkey  choices  ares 

1.  exit  to  "Main  Menu," 

2.  "Exit  Program," 

3.  "Acquire  Data," 

4.  "Manual  Set,"  and 

5.  "Change  Value." 


These  keys  work  as  described  in  the  time  calibration 
acquisition  section.  Again  for  data  consistency,  the  Manual  key 
does  not  result  in  permanent  changes.  The  "Manual  Set"  key  in 
this  menu  provides  a convenient  method  for  determining  the 
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voltage  calibration  interval,  step  size,  and  minimum  voltage. 
See  Sections  A. 4. 2 and  A. 4. 3 of  this  manual  for  more  details. 


4c 2. 4 Operator  information 

We  provide  this  feature  of  the  acquisition  program  to  give 
new  system  users  some  idea  of  the  programs  function  and  to 
highlight  a few  of  the  more  important  considerations  of  data 
acquisition  using  the  oscilloscope.  This  is  a limited  "Help" 
function.  You  may  alter  these  messages  to  fit  your  needs  by 
altering  the  source  code.  We  do  not  intend  this  attribute  as  a 
replacement  for  reading  this  manual  or  the  manuals  for  the  system 
hardware.  Any  information  contained  in  the  original  message  when 
you  select  the  operator  information  softkey  is  also  in  this 
manual . 

4 o 3 Oscilloscope  Calibration  --  (FIXACQ) 

FIXACQ  is  the  program  for  applying  the  voltage  and  time 
calibration  data  to  the  OUT  waveform.  You  may  elect  to  calibrate 
the  voltage  scale,  the  time  scale,  or  both  (see  Fig.  6) . If  you 
decide  to  apply  both  voltage  and  time  correction  to  the  OUT  data, 
the  voltage  calibration  will  always  be  done  before  the  time 
calibration. 

Once  the  program  starts,  you  will  be  prompted  to  input  the 
appropriate  file  names.  Error  checking  is  provided  to  insure 
that  you  do  not  attempt  to  use  an  empty  file. 

A confusing  situation  occurs  when  the  calibration  epoch  is 
less  than  the  measured  data  epoch.  This  creates  the  situation  in 
which  the  measured  data  extend  beyond  the  calibration  data  and 
the  question  arises  as  to  what  to  do  with  the  "extra11  measured 
data.  Should  this  occur,  you  will  have  seven  options.  These 
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START 


INITIALIZE 

VARIABLES 


Figure  6 


FIXACQ  flow  chart 


options  are  listed  below. 

0.  Abort  the  calibration;  no  new  data  will  be  saved. 

1.  Abort  only  the  time  base  calibration.  This  will  save 
the  voltage  calibrated  data. 

2.  Calibrate  and  output  fewer  data  points.  This  is  not 
recommended  since  the  fast  Fourier  transform  (FFT) 
routine  used  in  deconvolution  requires  waveforms  that 
are  2n  points  in  length. 

3.  Extrapolate  using  the  last  data  point. 

4.  Extrapolate  using  a value  input  from  the  keyboard. 

5.  Extrapolate  using  the  mean  value  of  the  last  5%  of  the 
data. 

6.  Extrapolate  using  the  mean  slope  of  the  last  5%  of  the 
data . 

In  this  program,  extrapolation  is  done  by  replacing  the 
uncorrected  points  with  the  value  for  the  given  option.  You  will 
choose  option  2 when  you  want  to  calibrate  the  DUT  waveform  and 
have  no  intention  of  deconvolving  the  calibrated  data. 

Generally,  we  select  option  6 as  a '‘best  guess"  for  what  the  data 
would  actually  be,  unless  there  are  compelling  reasons  for  one  of 
the  other  choices. 

After  calibrating  the  data,  you  will  be  prompted  to  input  a 
file  name  for  the  corrected  data  --  the  data  will  then  be  saved 
and  the  program  terminated.  The  data  are  saved  in  binary  data 
format  and  are  also  consistent  with  GRAPH_DATA . 

4.4  Deconvolution  — (DECON_NIST) 

You  will  use  this  deconvolution  program  for  both  the 
deconvolution  of  the  jitter  impulse  response  and  the  system 
impulse  response.  We  provide  the  system- impulse-response  data  as 
part  of  the  AWAMS.  These  data  are  complex  (incompatible  with 
GRAPHED AT A ) ; therefore,  you  will  need  to  respond  accordingly  when 
the  deconvolution  program  asks  for  the  data  type.  The  flow  chart 
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(Fig.  7)  shows  the  outline  of  the  steps  in  this  routine.  Further 


Figure  7.  DECON__NIST  flow  chart. 
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details  about  the  algorithms  for  waveform  extension , iterative  or 
single-pass  deconvolution,  and  FFT  preparation  follow.  See 
Section  2 of  this  manual  and  Refs.  [1]  through  [5]  for  more 
detail  on  the  theory  of  deconvolution. 

Theoretically,  deconvolution  is  a straightforward  operation. 
However,  in  the  presence  of  noise  and  other  uncertainties, 
deconvolution  becomes  complicated  [5].  Successful  use  of  this 
program  for  deconvolution  requires  some  insight. 

First,  you  will  be  asked  if  you  want  to  extend  the 
waveform (s) . If  the  DUT  waveform  is  step- like,  Nahman-Gans 
extension  [4]  (or  another  method  for  coping  with  record 
discontinuities  [3])  is  necessary  for  the  deconvolution  to  work. 
Also,  the  number  of  points  and  the  epoch  for  the  DUT  and  response 
waveforms  must  be  identical  for  the  deconvolution  to  work. 
Therefore,  if  you  extend  the  DUT  waveform,  you  will  have  to 
extend  the  response  waveform  also.  If  you  know  a waveform  has 
been  stored  in  extended  form,  as  with  the  system  response 
waveform  data  provided  as  part  of  the  AWAMS,  no  further  extension 
is  required. 

If  you  extend  the  DUT  waveform,  you  will  also  be  asked  what 
type  of  waveform  is  being  extended,  step-like  or  impulse-like. 
This  is  because  the  extension  method  is  different  for  each  of 

t 

these  waveform  types.  The  extension  of  step-like  waveform  is 
explained  in  the  preceding  paragraph  and  in  Section  2.3  of  this 
manual.  An  impulse-like  waveform  is  extended  by  adding  zeros  to 
the  waveform  up  to  the  desired  number  of  points  of  the  extension. 
Therefore,  the  program  prompts  you  for  the  appropriate  input  as 
needed,  but  you  will  need  to  know  the  right  answer (s) . If  you 
request  a waveform  extension  when  one  is  not  necessary,  the 
program  may  end  because  of  an  inconsistent  number  of  data  points, 
or  there  may  be  no  adverse  effect  if  both  the  DUT  and  the 
response  waveforms  are  unnecessarily  extended. 
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The  deconvolution  program  checks  for  consistency  in  the 
epoch  and  number  of  points  acquired.  The  program  will  not 
perform  the  deconvolution  and  will  end  normally  if  these 
conditions  are  not  met  and  you  will  have  to  re-run  the  program 
with  a consistent  data  set. 

The  second  aspect  of  this  deconvolution  program  that 
requires  explanation  and  decision  is  the  choice  between  iterative 
and  single-pass  deconvolution.  Select  the  single  pass  option 
only  when  you  already  know  the  optimal  value  of  F.  (F  is  the 
variable  parameter  that  we  use  for  selecting  the  optimal 
solution.)  When  the  optimal  value  of  F is  not  known,  select  the 
iterative  option.  The  iterative  option  causes  the  program  to 
search  for  the  optimal  solution  by  varying  the  value  of  r until 
our  stopping  criterion  is  met.  As  mentioned  in  Section  2,  our 
stopping  criterion  is  a minimum  in  see  eq  (8) . 

When  you  select  the  iterative  option,  you  will  be  asked  to 
input  the  starting  and  stopping  values  for  the  attenuation.  The 
optimizing  parameter,  F,  is  defined  by 


where  A is  the  attenuation.  Do  not  select  too  large  a range 
between  the  starting  and  stopping  attenuation  values.  Although 
you  may  be  more  assured  of  finding  the  correct  stopping  point, 
iterative  deconvolution  takes  a long  time,  and  a larger  range 
means  a longer  calculation  time.  It  is  all  too  easy  to  select  a 
range  for  the  attenuation  that  will  not  allow  the  program  to  find 
a stopping  point.  This  happens  when  the  range  selected  is  too 
far  from  the  correct  value.  Should  this  happen,  reset  the 
computer  and  run  the  program  using  a different  range  for  the 
attenuation  values.  We  are  investigating  other  methods  for 
finding  the  optimal  stopping  point;  these  may  result  in  a more 
robust  computation,  but  until  then,  you  must  develop  a feeling 
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for  what  will  and  will  not  work.  Typically,  if  the  two  waveforms 
for  deconvolution  are  similar,  the  optimal  value  of  r will  be 
small  (1CT3  or  smaller) . On  the  other  hand,  if  the  waveforms  are 
dissimilar,  as  is  most  often  true,  the  optimal  value  of  F can  be 
quite  large  (1023  or  larger) . Select  the  starting  and  stopping 
attenuation  values  based  on  the  waveforms  that  are  being 
deconvolved.  For  instance,  when  deconvolving  the  oscilloscope 
system  response  waveform  from  a measured  waveform,  we  most  often 
choose  a starting  attenuation  of  15  and  a stopping  attenuation  of 
20.  This  range  is  based  on  experience  with  this  deconvolution 
algorithm. 

The  third  aspect  of  DECON_NIST  we  describe  are  the  routines 
required  for  performing  the  Fourier  transforms.  Unlike  the 
extension  and  iteration  described  above,  the  FFT  routines  are 
transparent  to  the  user.  The  first  required  routine  is  called 
Dofft.  Do_f ft  sets  up  the  call  to  another  routine,  Fft_fix; 
interprets  any  errors  detected  by  Fft_fix;  and  sets  an  error  flag 
if  an  error  has  been  detected.  When  this  flag  is  set,  the 
program  terminates.  The  Fft_fix  routine  checks  the  data  for 
situations  that  will  generate  an  error  in  the  FFT;  if  no  errors 
are  detected,  it  splits  the  data  into  its  real  and  imaginary 
parts;  and  calls  the  FFT  subroutine.  When  an  error  occurs,  the 
error  flag  is  assigned  a number  based  on  the  cause  of  the  error. 
This  value  is  decoded  in  the  Do_fft  routine  resulting  in  an  on- 
screen error  message  and  program  termination. 

Finally,  we  describe  the  options  for  data  storage  in  this 
program.  You  will  be  given  the  choice  to  store  an  intermediate 
step  and  you  will  have  the  option  to  store  several  final  results. 
All  data  are  stored  in  binary  data  format  and  the  stored  files 
are  compatible  with  GRAPH_DATA.  The  first  result  you  may  choose 
to  keep  is  the  F-versus-Pi  curve  used  to  determine  the  optimal 
value  of  F.  This  is  an  intermediate  result  that  may  be  useful 
for  two  reasons.  First,  if  you  chose  to  re-run  this  program  on 
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the  same  data  set,  you  can  use  the  single-pass  option  since  you 
will  know  the  optimal  r.  And  second,  you  may  want  to  save  this 
information  for  comparison  with  other  similar  data  sets  or  as 
part  of  your  records  for  each  device  you  test.  After  the 
deconvolution  process  is  done,  you  will  have  the  option  of  saving 
the  spectrum  magnitude,  the  real  time-domain  result,  and/or  the 
imaginary  time  domain  result.  Usually,  the  only  result  you  will 
want  or  need  is  the  real  time-domain  result.  You  may  save  the 
spectrum  magnitude  for  any  waveform  type,  but  it  is  most  useful 
for  determining  the  frequency  content  of  pulses  used  for 
electromagnetic  interference  (EMI)  testing,  usually  an  impulse- 
like signal.  The  imaginary  result  is  made  available  in  case  you 
want  to  check  the  imaginary  part  to  assure  yourself  that  it  is 
small;  ideally  the  imaginary  part  of  a real-valued  waveform  is  0. 
If  you  elected  to  extend  the  OUT  waveform,  you  will  also  be  given 
the  option  of  saving  the  resultant  waveforms  in  the  extended  or 
half-length  forms.  If  you  are  saving  a system  impulse-response 
waveform  that  will  later  be  used  for  another  deconvolution,  save 
the  extended  versions.  If  you  are  not  going  to  do  any 
subsequent  deconvolution (s) , save  the  unextended  form  because  the 
extended  version  is  not  useful.  This  program  will  end 
automatically  when  the  data  have  been  stored. 

4 o 5 Pulse  Parameter  Calculation  — ( PUL S__P ARAMS) 

Load  and  run  PULS_PARAMS  (Fig.  8)  to  calculate  various  pulse 
parameters.  You  may  use  this  program  on  step-like,  square-like, 
or  impulse-like  waveforms.  To  make  the  program  more  general,  the 
units,  such  as  volts  and  seconds,  or  amperes  and  milliseconds, 
are  user  inputs;  this  allows  the  program  to  operate  on  different 
kinds  of  data.  This  program  calculates 

1.  peak  to  peak  and  0 percent  to  100  percent  data  values; 

2.  pulse  amplitudes; 

3.  10  percent  to  90  percent  and  20  percent  to  80  percent 
pulse  transition  durations; 
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START 


Figure  8 c PULS__P  ARAMS  flow  chart „ 


STOP 


4. 

5. 


percent  overshoot;  percent  undershoot; 

the  second  transition  durations  and  pulse  duration  for 
impulse  or  square  waveforms; 

6.  the  number  of  bins  used  to  create  the  histogram; 

7.  the  0 percent  and  100  percent  data  values;  and 

8.  the  number  of  data  occurrences  at  0 percent  and  100 
percent. 

It  also  displays  the  first,  last,  maximum,  and  minimum  data 
values . 

The  first  step  in  calculation  of  these  parameters  is  finding 
an  appropriate  histogram.  There  should  be  roughly  10  points  in 
either  the  100  percent  or  0 percent  bin  for  an  impulse-like 
waveform  and  10  points  for  both  the  0 percent  and  100  percent 
bins  for  a step-like  signal.  The  program  will  decrease  the 
number  of  histogram  bins  until  there  are  enough  data  occurrences 
in  the  0 percent  bin.  The  0 percent  bin  is  the  only  one  checked 
by  this  program.  Once  the  automatic  bin  calculation  is  done,  you 
will  be  asked  if  the  histogram  is  acceptable.  Reasons  for 
rejecting  the  histogram  include  an  insufficient  number  of  points 
at  100  percent  or  an  inadequate  y-axis  resolution.  If  for  any 
reason  the  histogram  is  unacceptable,  you  can  override  the 
automatic  bin  calculation  and  enter  in  the  number  of  bins  you 
want. 


The  second  step  is  to  define  the  0 percent  and  100  percent 
values.  If  the  pulse  waveform  is  negative-going,  the  100  percent 
value  becomes  the  0 percent  value  and  the  0 percent  value  becomes 
the  100  percent  value.  Be  aware  of  this  when  selecting  the 
definitions.  Your  options  for  0 percent  are: 

1.  value  of  the  first  point  in  the  waveform; 

2.  value  of  the  last  point  in  the  waveform; 

3.  the  minimum  value  in  the  waveform; 

4.  the  0 percent  value  found  by  the  histogram;  or 

5.  you  may  input  a value  from  the  keyboard. 
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Your  options  for  100  percent  are: 


1.  value  of  the  first  point  in  the  waveform; 

2.  value  of  the  last  point  in  the  waveform; 

3.  the  maximum  value  in  the  waveform; 

4.  the  100  percent  value  found  by  the  histogram;  or 

5.  you  may  input  a value  from  the  keyboard. 

If  the  waveform  is  step-like  or  square,  you  will  want  to  pick  the 
values  found  by  the  histogram  (option  4)  for  both  0 and  100 
percent.  If  the  waveform  is  impulse-like,  you  will  want  to  pick 
the  value  found  by  the  histogram  (option  4)  for  0 percent  and  the 
maximum  waveform  value  (option  3)  for  100  percent. 

After  you  input  the  required  level  definitions,  the  program 
automatically  continues  with  the  calculation  of  the  pulse 
parameters.  When  these  calculations  are  finished,  you  will  be 
asked  to  input  a file  name  for  data  storage.  These  data  are 
stored  in  ASCII  format. 

You  will  then  be  asked  if  you  would  like  a hard  copy  print- 
out of  the  results.  If  you  choose  not  to  print  the  result  at  run 
time,  you  can  obtain  a hard  copy  later  by  running  the  "text_outn 
program.  This  program  simply  reads  in  an  ASCII  file  and  prints 
it.  Just  load  and  run  the  program  and  answer  the  questions 
given. 
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4 . 6 Support  Programs 


4c 6.1  Jitter  waveform  generator  — - (GAUSS) 

This  program  is  used  to  create  a waveform  that  approximates 
the  jitter  distribution  function  of  the  measurement  system.  This 
function  can  be  deconvolved  from  the  DUT  waveform  data.  The 
first  step  in  using  this  program  is  to  measure  sigma  (a)  of  the 
jitter  of  the  DUT.  Sigma  is  the  sum  of  the  squared  deviations  of 
the  measurements  from  their  mean.  This  measurement  is  explained 
in  Section  A. 4. 4 of  this  manual. 

After  measuring  the  value  of  o of  the  jitter,  load  and  run 
GAUSS  (see  Fig.  9) . You  will  be  prompted  to  input  values  for  the 
number  of  points  in  the  waveform,  the  epoch  of  the  waveform,  and 
the  value  of  o (Section  A. 4. 4)  as  needed.  The  number  of  points 
and  the  epoch  of  the  jitter  distribution  function  must  be  equal 
to  the  number  of  points  and  the  epoch  of  the  DUT  waveform  for 
deconvolution.  To  make  the  jitter  distribution  function  waveform 
more  like  an  impulse  response,  we  create  a Gaussian  curve  with 
unit  area.  If  you  choose  other  than  unit  area,  you  will  be 
prompted  to  input  an  amplitude  value.  When  the  waveform  has  been 
calculated,  you  will  be  asked  for  a file  name  for  data  storage. 
The  result  is  stored,  and  the  program  ended.  Again,  the  data  are 
stored  in  binary  data  format  and  the  file  written  is  compatible 
with  GRAPH  DATA. 


4.6.2  Waveform  math  operations  utility  (MATH_OPS) 

The  MATH_OPS  program  allows  you  to  perform  some  basic 
operations  on  the  waveforms.  These  operations  are:  integration, 
differentiation,  time  shifting,  and  constant  arithmetic 
operations  of  addition,  subtraction,  multiplication,  and  division 
(see  Fig.  10) . This  program  is  similar  in  style  to  the 
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START 


Figure  9.  GAUSS  flow  chart 


START 


Figure  10 . MATH  OPS  flow  chart. 
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acquisition  program  since  it  is  menu  driven.  To  perform  one  of 
the  above  operations,  press  the  appropriate  softkey.  To  leave 
the  program,  select  the  "Exit”  key  from  the  main  menu. 

The  first  step  after  loading  and  running  this  program  is  to 
use  the  "Load  Data"  softkey.  If  you  fail  to  do  this  before 
attempting  to  perform  any  of  the  math  operations,  the  program 
will  display  a message  telling  you  there  is  no  file  in  memory  and 
return  you  to  the  main  menu  so  that  you  may  load  in  a file. 

After  every  math  operation,  the  file  in  the  program  memory  is 
purged  (this  does  not  imply  that  data  have  been  lost  since  the 
data  are  stored  in  one  of  the  mass  storage  units) . This  means 
you  will  have  to  load  a file  before  beginning  a math  operation. 
This  program  reads  and  writes  files  in  binary  data  format  and  the 
file  structure  is  compatible  with  GRAPH_DATA . 

The  program  will  perform  the  corresponding  function  when  you 
press  the  "Integrate"  or  "Differentiate"  softkeys.  Because  the 
data  on  which  this  program  operates  are  discrete,  rather  than 
continuous,  the  integration  and  differentiation  are  actually 
summation  and  first  difference  respectively.  After  completing 
the  selected  operation,  the  program  requests  a file  name  and  a 
disk  for  data  storage,  the  data  are  saved  and  the  program  returns 
to  the  main  menu. 

To  access  the  time  shift  operation,  which  is  useful  for 
comparing  multiple  waveforms,  press  the  "Time  Shift"  key  from  the 
main  menu.  The  program  will  then  display  a new  menu.  The 
options  available  in  this  menu  are  to 

1.  start  the  array  at  the  index  corresponding  to  the 
maximum  voltage  value; 

2 . start  the  array  at  the  index  corresponding  to  the 
minimum  voltage  value;  or 

3c  input  the  starting  index  number  from  the  keyboard. 
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By  aligning  the  waveforms  according  to  a particular  waveform 
feature  you  will  be  able  to  easily  discern  differences  and 
similarities.  After  you  select  the  required  starting  point,  the 
data  are  rearranged.  You  are  then  asked  for  a file  name  and  disk 
drive  for  data  storage,  the  data  are  stored,  and  the  program 
returns  to  the  main  menu.  To  see  the  rearranged  waveforms,  use 
GRAPH_DATA. 

If  you  want  to  add,  subtract,  multiply,  or  divide  the  y-axis 
data  by  a constant,  press  the  "+-*/  Y"  menu  key.  You  will  then 
have  the  following  softkey  menu  options i add,  subtract,  multiply, 
and  divide.  After  selecting  one  of  the  options,  input  the  value 
for  the  constant;  the  program  then  performs  the  required 
operation.  Then  when  asked  input  the  file  name  and  designate  a 
disk  drive  for  data  storage,  the  data  are  then  saved,  and  the 
program  returns  to  the  main  menu. 

To  leave  this  program,  press  the  "Exit"  key. 

4.6.3  Graphics  Support  ( GRAPH__D ATA ) 

The  AWAMS  package  includes  an  up-to-date  version  of  the 
NIST-written  graphics  support  package,  GRAPH_DATA . GRAPH_DATA 
has  been  modified  to  include  the  ability  to  draw  a histogram  plot 
on  the  same  graph  with  a waveform  plot.  In  order  to  include  the 
histogram  plot  with  the  waveform  plot,  you  must  follow  a number 
of  steps  in  sequence.  It  is  easiest  to  follow  this  procedure 
while  you  are  using  GRAPH_DATA  and  actually  performing  the  key 
presses . 

1.  Load  the  desired  file  or  select  it  for  plotting  if  it 
is  already  in  GRAPH_DATA. 

2.  After  selecting  the  required  file,  go  to  the  "Auto 
Scale"  option  and  rescale  the  graph  to  this  data  set. 
Now  is  the  time  to  do  any  manual  scaling  you  require. 
This  is  done  in  the  "Edit  Background"  menu. 
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3,  Select  the  "Edit  Background"  option,  press  the  "Graph 
Type"  softkey,  and  select  the  "Histogram"  option. 

4 o Return  to  the  "Edit  Data"  menu  and  select  the  "Data 

Math"  key  and  then  the  "User"  key  (access  the  "User" 
key  by  pressing  the  shift  key  on  the  keyboard  and  9th 
softkey).  When  asked,  type  in  "GD__HXSTOGRM" • This 
subroutine  operates  in  the  same  way  as  the  histogram 
routine  in  the  pulse  parameters  program,  see  Ref.  [7] 
for  details. 

5.  Finally,  select  the  curve  you  just  created  for  plotting 
and  return  to  the  main  menu. 

It  is  essential  that  you  select  only  one  file  for  both 
plotting  and  histogram  generation  as  the  results  will  be  quite 
confusing  if  you  do  not.  At  this  point,  do  not  re-scale  the 
graph . The  scaling  of  the  axes  of  the  histogram  graph  is 
dependent  on  the  position  of  the  waveform  data  graph.  Using 
"Auto  Scale"  or  redefining  the  graph  type  will  cause  an  odd 
looking  result.  However,  you  may  add  labels,  change  pen  color, 
or  any  other  operation  that  does  not  rescale  the  graph. 

GRAPH_DATA  has  many  other  features,  but  these  are  not 
directly  related  to  the  AWAMS  and  are  therefore  not  documented 
here. 
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5.0  SYSTEM  CONSIDERATIONS 


For  details  on  computer,  computer  peripherals,  and 
oscilloscope  operation,  see  the  corresponding  operation  manuals 
listed  in  Section  A. 3. 

5 . 1 System  Changes 

The  AWAMS,  as  delivered,  will  not  need  reconfiguring  after 
installation.  However,  if  you  decide  to  change  the  device  bus 
addresses  or  change  the  system  hardware,  you  will  also  need  to 
change  the  software  to  match.  Feel  free  to  change  bus  addresses, 
user  messages,  default  values,  etc.  However,  please  contact  the 
software  author (s)  before  making  any  changes  to  the  algorithms  to 
maintain  consistency  between  the  NIST  Automatic  Waveform  Analysis 
and  Measurement  System  (AWAMS)  and  the  AWAMS. 

5.2  Acquisition  Setup 

1.  When  you  acquire  a waveform  by  the  computer,  the  voltage 
scale  seen  on  the  oscilloscope  screen  is  not  necessarily  the 
voltage  scale  acquired.  For  example,  if  the  signal  you 
measure  is  nominally  300  mV  and  the  oscilloscope  is  set  at 
10  mV  per  division  and  the  offset  is  set  to  center  the 
signal,  you  will  see  a clipped  waveform  on  the  screen  of  the 
oscilloscope,  but  the  acquired  waveform  will  not  be  clipped. 
The  exception  is  when  the  signal  exceeds  the  maximum  voltage 
for  the  analog-to-digital  converter.  In  that  case,  the 
acquired  signal  will  be  clipped  since  this  voltage  exceeds 
the  maximum  oscilloscope  capability.  WARNING:  The  maximum 
safe  input  voltage  into  any  measurement  channel  or  into  the 
external  trigger  is  ±2  Vdc  ± ac  peak.  Input  voltages  that 
exceed  this  level  may  damage  or  destroy  the  sampling 
circuitry.  Measurement  of  signals  of  this  magnitude,  or 
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because  you  may  destroy  the  sampling  heads  of  the 
oscilloscope.  See  [MUD  1]  for  details  on  the  oscilloscope 
specifications.  If  you  want  to  see  a clipped  version  of  the 
waveform  after  acquisition,  use  the  manual  scaling  feature 
of  GRAPH__DATA  to  display  only  the  desired  part  of  the 
waveform. 

2.  Every  4 ns,  the  oscilloscope  will  update  the  clock  for 
the  time  axis.  This  event  occurs  at 

16  +42\Tns,  N=  0,1,2...  (10) 


It  is  essential  that  your  measurement  does  not  include  these 
events.  External  delay  line(s)  inserted  in  the  trigger 
circuit  may  be  required  to  meet  this  condition.  We  do  not 
recommend  inserting  extra  cables  in  the  signal  path  because 
of  losses  in  the  lines  and  subsequent  distortion  of  the 
signal.  If  you  have  set  up  the  measurement  correctly,  this 
should  be  no  problem  for  small  epochs. 

3.  When  positioning  the  DUT  waveform  on  the  oscilloscope 
screen,  you  want  the  beginning  and  ending  parts  of  the 
waveform  to  visually  have  nearly  zero  slope.  This  condition 
gives  the  best  results  for  any  subsequent  deconvolution. 
Usually,  when  the  waveform  is  in  this  position,  the  voltage 
midpoint  will  be  between  the  first  and  third  graticules. 

4.  The  FFT  used  by  the  AWAMS  requires  2n  points,  where  n is 
an  integer.  Pick  the  epoch  for  measurement  so  that  you  can 
chose  the  number  of  points  accordingly.  For  instance, 
select  a 2-ns  epoch  and  then  choose  2048  points. 

5.  Increasing  the  number  of  points  and/or  the  number  of 
averages  in  the  measurement  increases  the  acquisition  time 
(Section  4.2).  It  takes  approximately  15  minutes  to  acquire 
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(Section  4.2).  It  takes  approximately  15  minutes  to  acquire 
a waveform  with  1024  points  and  2048  averages.  Choose  the 
maximum  number  necessary  for  each  measurement. 

6.  The  acquisition  program  checks  for  many  error  conditions. 
However,  if  you  mistakenly  acquire  from  the  wrong  sampling 
channel,  the  data  will  not  be  what  you  want.  If  you  get  a 
large  number  of  time  calibration  factors  after  using  the 
TCAL  feature  of  the  ACQUIRE  program,  this  is  likely  the 
problem.  Check  your  setup  and  try  again. 

5.3  Oscilloscope  and  Computer 

1.  For  a complete  list  of  the  environmental  and  operating 
requirements  of  the  oscilloscope  and  computer  see  [MUD 

2 . Please  wear  the  grounding  wrist  strap  when  operating  the 
oscilloscope.  For  a complete  list  of  precautions  for 
avoiding  electrostatic  discharge  damage  to  the  oscilloscope, 
see  [MUD  {1}] . 

3.  The  oscilloscope's  input  connectors  are  precision  3.5-mm 
connectors.  Although  SMA  and  the  precision  3.5-mm 
connectors  appear  to  mate  well,  a bad  SMA  can  ruin  a good 
3.5-mm  connector.  Please  gauge  all  SMA  connectors  before 
coupling  to  the  oscilloscope  to  verify  that  they  will  not 
harm  the  input  connectors.  To  increase  the  lifetime  and 
maintain  precision  of  the  connectors,  you  must  use  the 
connectors  correctly.  Please  read  [MUD  {1}]  for  care  and 
handling. 
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7.0  GLOSSARY 


bandwidth 

the  upper  frequency  limit  at  which  the  oscilloscope's 
voltage  response  has  decreased  to  71  percent  from  its  flat 
frequency  response  region. 

continuous  time 

all  time  values,  however  small  the  time  increment.  A 
continuous-time  function  is  defined  for  all  time. 

convolution 

mathematically,  it  is  the  integration  of  the  multiplication 
of  one  function  and  a time-shifted  replica  of  a second 
function.  A physical  example  is  the  interaction  of  an  input 
waveform  and  a measurement  system  which  can  be  described 
mathematically  by  a convolution  integral. 

deconvolution 

a mathematical  process  that  allows  the  reconstruction  of  one 
of  the  two  waveforms  involved  in  a convolution.  Knowledge 
of  one  of  the  waveforms  involved  in  the  convolution  is 
necessary  in  order  to  perform  a deconvolution. 

discrete-time 

specific  time  values,  fixed  incremental  time  steps.  A 
discrete-time  function  is  defined  only  at  specific  time 
values. 

equivalent-time  sampling 

sampling  of  successive  points  along  a periodically  repeated 
waveform  so  that  the  sequence  of  sampled  points  may  be  used 
to  reconstruct  the  waveform.  For  example,  sampling  one 
point  from  nonidentical  locations  on  each  of  ten  identical 
repeats  of  a waveform  will  allow  a 10-point  reconstruction 
of  the  waveform. 

Fourier  transform 

mathematical  transformation  of  time  data  into  its 
sinusoidally  varying  components,  or  the  reverse  process. 

impulse  response 

the  temporal  response  of  a given  device  to  excitation  by  a 
unit-height  delta  function,  or  impulse. 

interpolate 

a method  to  infer  the  value  of  a nonexistent  datum,  where 
that  datum  is  located  between  known  or  measured  data  values. 
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j itter 

random  synchronization  errors  between  the  trigger.  d 
associated  event. 


sampling  window  (aperture) 

the  time  duration  over  which  the  sampling  process  occurs. 


time  aliasing 

a distortion  in  the  time  representation  of  a waveform  caused 
by  not  satisfying  the  sampling  criterion.  Basically,  the 
ends  of  the  waveforms  overlap  and  add,  thus  causing  errors 
in  these  portions  of  the  waveforms. 
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APPENDIX  A 


A. 1 Specifications 

The  following  table  lists  the  various  pulse  parameters, 
including  their  ranges  and  uncertainties,  that  are  measured  with 
the  AWAMS. 


PARAMETER 

RANGE 

TYPICAL  LIMITS  OF 
UNCERTAINTY 

Pulse  Baseline 
(0%  level) 

±500  mV 

±(0.5%  + 3 mV) 

Pulse  Topline 
(100%  level) 

±500  mV 

±(0.5%  + 3 mV) 

Pulse  Amplitude 

±500  mV 

±(0.5%  + 3 mV) 

Pulse  First 
Transition  Duration 
(Rise  Time) 

10  ps  to  100  ns 

±(0.5%  + 3 ps) 

Pulse  Second 
Transition  Duration 
(Fall  Time) 

10  ps  to  100  ns 

±(0.5%  + 3 ps) 

Pulse  Duration 
(between  50%  levels) 

10  ps  to  100  ns 

±(0.5%  + 3 ps) 
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A. 2 AWAMS  Hardware 


The  following  list  provides  an  inventory  of  the  hardware 
presently  provided  with  the  AWAMS.  A brief  description  of  these 
components  is  also  given.  However,  for  detailed  information , 
please  see  the  manufacturer  users's  manuals  listed  in  Sec.  A. 3. 
We  use  trade  names  to  specify  the  equipment  used  in  this  system 
and  no  endorsement  by  the  National  Institute  of  Standards  and 
Technology  is  implied.  Similar  products  by  other  manufacturers 
may  work  as  well  or  better. 

Digitizing  oscilloscope 

The  HP  Model  54120T  digitizing  oscilloscope  provides  20  GHz 
bandwidth,  full  IEEE  488  programmability,  time-domain 
ref lectometry  capability,  and  waveform  arithmetic  operations. 

Computer/ instrument  controller 

The  HP  9000/300  Microcomputer  operates  at  16.6  MHz,  has  8 
megabytes  of  RAM,  and  IEEE  488,  LAN,  and  RS232C  interfaces. 

Disk  Drives 

The  HP  9127A  Disk  Drive  uses  5.25-inch  diameter,  magnetic 
storage,  flexible  disks. 

The  HP  9122C  has  2-megabyte  data  storage  capacity  and  uses 
double-sided,  3.5-inch  diameter  floppy  disks. 

The  HP  7957B  is  a hard  disk  drive  unit  and  has  81-megabyte 
of  data  storage  capacity. 

Printers 

The  HP  ThinkJet  and  HP  PaintJet  printers  are  used  with  the 
AWAMS. 
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A. 3 Manufacturers'  Users'  Documentation 


The  following  is  a list  of  the  manufacturers'  users' 
documentation.  Familiararity  with  these  manuals  is  essential  to 
the  proper  operation  of  the  AWAMS. 


1.  "HP  54120  User  Documentation  (Installation/Operation 
Manual),"  HP  Manual  Part  Number  98613-90000,  Hewlett-Packard 
Company,  U.S.A.,  1987. 

2.  "HP  54121T  Digitizing  Oscilloscope  Programming  Reference," 

HP  Manual  Part  Number  54121-90907,  Hewlett-Packard  Company, 
UoScAo,  1989. 

3.  "Using  the  BASIC  5. 0/5.1  System,  HP  9000  Series  200/300,"  HP 
Part  Number  98613-90000,  Hewlett-Packard,  U.S.A.,  1988. 

4.  "BASIC  5. 0/5.1  Interfacing  Techniques,  Vol.  1 ; General 
Topics,  HP  9000  Series  200/300  Computers,"  HP  Part  Number 
98613-90022,  Hewlett-Packard  Company,  U.S.A.,  1987. 

5.  "Basic  Language  Reference  Volume  1 A-N,"  HP  Part  Number 
98613-90052,  Hewlett-Packard  Company,  U.S.A.,  1989. 

6.  "Basic  Language  Reference  Volume  1 O-Z,"  HP  Part  Number 
98613-90052,  Hewlett-Packard  Company,  U.S.A.,  1989. 

7.  "Basic  5. 0/5.1  Programming  Techniques  Volume  1 : General 
Topics,"  HP  Part  Number  98613-90813,  Hewlett-Packard 
Company,  U.S.A.,  1988. 

8.  "Installation  Reference,  HP  9000  Series  300  Computers,"  HP 
Part  Number  9856-90000,  Hewlett-Packard  Company,  U.S.A., 

1988. 

9.  "Getting  Started  with  Your  HP  9127A  Disc  Drive,"  HP  Manual 
Part  Number  09127-90000,  Hewlett-Packard  Company,  U.S.A., 

1989. 

10.  "Getting  Started  with  Your  HP  9122C  Disc  Drive,"  HP  Manual 
Part  Number  09122-90901,  Edition  2,  Hewlett-Packard  Company, 
U.S.A.,  1988. 

11.  "HP  7957B , HP  7958B,  and  HP  7959B  Disc  Drives,"  HP  Manual 
Part  Number  07959-90901,  Hewlett-Packard  Company,  U.S.A., 
1988. 
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12.  "Personal  Printer  ThinkJet,  Owner's  Manual,”  HP  Manual  Part 
Number  02225-90031,  Hewlett-Packard  Company,  Singapore, 
1987. 
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A. 4 Measurement  Setup  and  Example  Procedures 


A. 4.1  General 

Please  read  the  section  titled  "Handling  and  Care  of  the 
Precision  Connectors"  [MUD{1}]  before  using  the  oscilloscope. 

1.  Clean  all  connectors  on  the  oscilloscope,  the  DUT,  the 
voltage  calibration  standard,  the  time  calibration 
standard,  and  any  required  adapters,  filters,  and 
cables . 

2.  Connect  the  3 . 5 -mm  shorts  to  all  of  the  oscilloscope 
channels  and  the  trigger  input.  Run  the  vertical 
calibration  utility  of  the  oscilloscope  [MUD{1}]0 

3.  You  may  use  any  of  the  four  sampling  channels  for  the 
measurement;  this  is  represented  as  "Chan  X"  in  Figs. 

A1  and  A2 . The  asterisks  in  Figs.  A1  and  A2  indicate 
the  equipment  supplied  as  part  of  the  AWAMS. 

4.  The  solid  lines  in  Figs.  A1  and  A2  represent  the  DUT 
connections,  the  dotted  lines  the  time  calibration 
standard  connections,  and  the  dashed  lines  the  voltage 
calibration  connections.  The  test  equipment  marked  with 
an  "*"  in  Figs.  A1  and  A2  are  the  only  pieces  that  are 
provided  as  part  of  the  AWAMS.  You  must  provide  all 
other  test  equipment. 

5.  Record  the  time,  the  date,  and  the  room  temperature  and 
humidity  before  beginning  data  acquisition.  These 
values  should  be  recorded  periodically  throughout  the 
test. 

A.4.2  Pulse  generator,  procedure  1 

This  procedure  is  used  for  measuring  the  Tektronix  S-52 
pulse  generator  output;  this  pulser  will  be  referred  to  as  PI. 
NIST  has  received  many  requests  to  the  measure  the  output  of  PI 
and,  consequently,  has  developed  procedures  for  measuring  its 
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CALIBRATION  SETUP  FOR  PI 
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Sampler 


Chan  X 
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Figure  Ale  Pulse  generator  measurement  setup  1. 
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CALIBRATION  SETUP  FOR  P2 


Figure  A2 . Pulse  generator  measurement  setup  2. 


output . 

However,  this  does  not  imply  any  preference,  by  NIST, 

for  this 

product . 

1. 

Load  and  run  the  ACQUIRE  program.  You  should  determine 
and  set  the  acquisition  parameter  values  for  each  menu 
before  acquiring  any  data.  Procedures  for  determining 
these  values  follow.  Once  the  menus  have  been  set  up, 
you  will  not  need  to  redo  them.  You  will  acquire  nine 
or  more  data  sets.  A data  set  consists  of  one  OUT 
waveform,  one  time-calibration  waveform,  and  one  group 
(see  VCAL  description)  of  voltage-calibration  factors. 
You  may  acquire  these  three  components  in  any  order  but 
each  set  must  be  completed  before  beginning  another. 
Once  you  choose  an  order  of  acquisition,  maintain  that 
order  throughout  the  test.  For  example,  first  acquire 
the  time-calibration  data,  then  the  voltage-calibration 
data,  and  finally,  the  DUT  data. 

2. 

Connect  the  PI  as  shown  in  Fig.  Al.  Press  the  waveform 
menu  key  and  select  the  manual  setup  option.  View  the 
DUT  waveform  on  the  oscilloscope  screen  and  manually 
position  the  waveform  as  required. 

Typical  PI  settings  ares 
Channel  4; 

Volts  per  Divisions  50  mV; 

Offset:  215.00  mV; 

Attenuation:  1; 

Time  per  Division:  200  ps; 

Delay:  81.275  ns; 

Delay  Reference:  center; 

Points:  1024; 

Averages:  2048; 

Trigger  Level:  300  mV; 

Trigger  Slope:  positive  (this  is  not  one  of  the 
ACQUIRE  program  menu  selections) . 
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These  are  typical  settings;  yours  may  be  different. 
Write  down  the  oscilloscope  settings  that  you  use. 

Make  certain  that  the  time  window  does  not  have  one  of 
the  4 -ns  boundaries  described  in  Sec.  5.2.  If  the 
epoch  does  have  a 4 -ns  boundary,  you  may  need  to  use  an 
external  delay  line  to  reposition  the  waveform.  Check 
the  minimum  and  the  maximum  voltages  that  span  the 
waveform's  voltage  range;  this  will  be  used  in  the 
subsequent  voltage  calibration.  Once  the  oscilloscope 
has  been  setup,  return  to  the  main  menu. 

3.  Connect  your  time  calibration  standard  as  shown  in  Fig. 
Al.  Press  the  TCAL  menu  key  and  then  the  manual  setup 
key.  View  the  waveform  and  establish  the  required 
oscilloscope  settings.  The  first  mid-point  crossing  of 
the  time  calibration  waveform  should  occur  before  the 
location  of  the  first  transition  of  the  pulse  waveform. 
The  time/div  and  the  delay  settings  of  the  oscilloscope 
must  be  the  same  as  the  those  for  DUT.  Use  external 
delay  lines  to  position  the  calibration  waveform.  You 
may  change  the  volts  per  division  and  offset  settings 
as  needed.  Typical  time  calibration  settings  are: 

Frequency:  5.0xl09  Hz; 

Volts  per  division:  1.0  mV; 

Offset:  0.0  mV  (as  needed  to  center  the  waveform); 

Number  of  sliding  average  point  pairs:  7; 

Number  of  least  squares  points:  20; 

Slope:  positive; 

Save  the  waveform:  no; 

Time  calibration  signal  trigger  level:  150  mV. 
Record  the  time  calibration  settings.  Return  to  the 
main  menu. 

4.  Connect  your  DC  standard  as  shown  in  Fig.  Al.  Press 
the  VCAL  key  and  then  the  manual  setup  key.  The  volts 
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per  division  and  offset  values  must  be  the  same  as 
those  for  the  DUT.  Other  settings  will  invalidate  the 
voltage-calibration  data.  Determine  the  number  of 
voltage  steps  and  the  voltage  increment  needed  to  span 
the  waveforms  voltage  range  (previously  determined) . 
Typical  settings  are: 

Voltage  intervals:  7; 

Averages:  128; 

Minimum  or  starting  voltage:  0.05  mV; 

Voltage  step  size:  0.05  mV. 

Record  the  voltage  calibration  settings. 

5.  Acquire  and  record  the  nine  sets  of  data. 

6.  When  you  have  collected  nine  data  sets,  exit  the 
ACQUIRE  program. 

7.  Measure  the  sigma  for  the  jitter  impulse  response.  The 
procedure  for  measuring  the  jitter  is  outlined  in  Sec. 
A. 4. 4 of  this  Manual. 

8.  Create  the  jitter  impulse  response  using  the  GAUSS 
program. 

9.  Calibrate  all  nine  waveforms  using  the  FIXACQ  program 
and  the  corresponding  calibration  data. 

10.  Deconvolve  the  jitter  function  from  all  nine  calibrated 
waveforms  using  the  D ECONOMIST  program. 

11.  Deconvolve  the  system  impulse  response,  SYS_RESP,  from 
all  nine  calibrated,  jitter-deconvolved  waveforms  using 
the  DECON_NXST  program.  SYS_RESP  is  the  name  of  the 
file  that  contains  the  system  impulse  response  for  the 
oscilloscope . 

12.  Run  the  PULS_PARAMS  program  on  all  nine  of  the 
calibrated,  jitter-deconvolved,  system-deconvolved 
waveforms.  These  are  the  corrected  waveforms. 

13 . Calculate  the  mean  and  standard  deviation  of  the 
following  parameters:  pulse  amplitude  (not  the  peak-to- 
peak  value) , 10-90%  transition  duration,  20-80% 
transition  duration,  percentage  overshoot,  and  the 
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percentage  undershoot.  (Do  these  calculations  for  all 
of  the  pulse  parameter  data  that  you  have  generated.) 

14.  Determine  which  of  the  nine  corrected  waveforms  has 
parameter  values  closest  to  the  mean  values  calculated 
above;  this  is  the  representative  waveform.  Use  this 
representative  waveform  for  the  report  plots. 

15.  Plot  the  representative  waveform. 

16.  Calculate  the  uncertainties  in  the  representative 
waveform's  pulse  parameters.  You  may  use  the  limits 
listed  in  Sec.  A.l  for  these  calculations. 

17 o Generate  the  test  report. 

A. 4. 3 Pulse  generator,  procedure  2 

This  procedure  is  used  for  measuring  the  Hewlett-Packard 
1106A  and  1106B  pulse  generator  outputs;  these  pulsers  will  be 
referred  to  as  P2 . NIST  has  received  many  requests  to  the 
measure  the  output  of  P2  and,  consequently,  has  developed 
procedures  for  measuring  its  output.  However,  this  does  not 
imply  any  preference,  by  NIST,  for  this  product. 

1.  Load  and  run  the  ACQUIRE  program.  You  should  determine 
and  set  the  acquisition  parameter  values  for  each  menu 
before  acquiring  any  data.  Procedures  for  determining 
these  values  follow.  Once  the  menus  have  been  set  up, 
you  will  not  need  to  redo  them.  You  will  acquire  nine 
or  more  data  sets.  A data  set  consists  of  one  DUT 
waveform,  one  time-calibration  waveform,  and  one  group 
of  voltage-calibration  factors.  You  may  acquire  these 
three  components  in  any  order  each  set  must  completed 
before  beginning  another.  Once  you  choose  an  order  of 
acquisition,  maintain  that  routine  throughout  the  test. 
For  example,  first  acquire  the  time-calibration  data, 
then  the  voltage-calibration  data,  and  finally,  the  DUT 
data. 


All 


2. 


Connect  P2  as  shown  in  Fig.  A2 . Press  the  waveform 
menu  key  and  then  select  the  manual  setup  option.  View 
the  DUT  waveform  on  the  oscilloscope  screen  and 
manually  position  the  waveform  as  required. 

Typical  P2  settings  ares 
Channel  4; 

Volts  per  division:  50  mV; 

Offset:  235.00  mV  (as  required  to  center  the 
waveform) ; 

Attenuation:  1; 

Time  per  division:  200  ps; 

Delay:  33.100  ns; 

Delay  Reference:  center; 

Points:  1024; 

Averages:  2048; 

Trigger  Level:  400  mV; 

Trigger  Slope:  positive  (this  is  not  one  of  the 
ACQUIRE  program  menu  selections) . 

These  are  typical  settings;  yours  may  be  different. 
Write  down  the  oscilloscope  settings  that  you  use. 

Make  certain  that  the  time  window  does  not  have  one  of 
the  4-ns  boundaries  described  in  Sec.  5.2.  If  the 
epoch  does  have  a 4 -ns  boundary,  you  may  need  to  use  an 
external  delay  line  to  reposition  the  waveform.  Check 
the  minimum  and  the  maximum  voltages  that  span  the 
waveform's  voltage  range;  this  will  be  used  in  the 
subsequent  voltage  calibration.  Once  the  oscilloscope 
has  been  set  up,  return  to  the  main  menu. 

3.  Connect  your  time  calibration  standard  as  shown  in  Fig. 
A2  c Press  the  TCAL  menu  key  and  then  the  manual  setup 
key.  View  the  waveform  and  establish  the  required 
oscilloscope  settings.  The  first  mid-point  crossing  of 
the  time  calibration  waveform  should  occur  before  the 
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location  of  the  first  transition  of  the  pulse  waveform. 
The  time  per  division  and  the  delay  settings  of  the 
oscilloscope  must  be  the  same  as  the  those  for  DUT.  Use 
external  delay  lines  to  position  the  calibration 
waveform.  You  may  change  the  volts  per  division  and 
offset  settings  as  needed.  Typical  time  calibration 
settings  are: 

Frequency:  5.0xl09  Hz; 

Volts  per  division:  1.0  mV; 

Offset:  0.0  mV  (as  needed  to  center  the  waveform); 

Number  of  sliding  average  point  pairs:  7; 

Number  of  least  squares  points:  20; 

Slope:  positive; 

Save  the  waveform:  no; 

Time  calibration  signal  trigger  level:  150  mV. 
Record  the  time  calibration  settings.  Return  to  the 
main  menu. 

4.  Connect  your  DC  standard  as  shown  in  Fig.  A2 . Press 
the  VCAL  key  then  the  manual  setup  key.  The  volts  per 
division  and  offset  values  must  be  the  same  as  those 
for  the  DUT.  Other  settings  will  invalidate  the  voltage 
calibration  data.  Determine  the  number  of  voltage 
steps  and  the  voltage  increment  needed  to  span  the 
waveforms  voltage  range  (previously  determined) . 

Typical  settings  are: 

Voltage  intervals:  7; 

Averages:  128; 

Minimum  or  starting  voltage:  0.05  mV; 

Voltage  step  size:  0.05  mV. 

Record  the  voltage  calibration  settings. 

5.  Acquire  and  record  the  nine  sets  of  data. 

6.  When  you  have  collected  nine  data  sets,  exit  the 
ACQUIRE  program. 
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7.  Measure  the  sigma  for  the  jitter  impulse  response.  The 
procedure  for  measuring  the  jitter  is  outlined  in  Sec. 
A. 4. 4 of  this  Manual. 

a.  Create  the  jitter  impulse  response  using  the  GAUSS 
program. 

9.  Calibrate  all  nine  waveforms  using  the  FIXACQ  program 
and  the  corresponding  calibration  data. 

10.  Deconvolve  the  jitter  function  from  all  nine  calibrated 
waveforms  using  the  DECON_NIST  program. 

11.  Deconvolve  the  system  impulse  response,  SYS__RESP,  from 
all  nine  calibrated,  jitter-deconvolved  waveforms  using 
the  DECON_NXST  program.  SYS_RESP  is  the  name  of  the 
file  that  contains  the  system  impulse  response  for  the 
oscilloscope . 

12.  Run  the  PULS_PARAMS  program  on  all  nine  of  the 
calibrated,  jitter-deconvolved,  system-deconvolved 
waveforms.  These  are  the  corrected  waveforms. 

13 . Calculate  the  mean  and  standard  deviation  of  the 
following  parameters:  pulse  amplitude  (not  the  peak-to- 
peak  value) , 10-90%  transition  duration,  20-80% 
transition  duration,  percentage  overshoot,  and  the 
percentage  undershoot.  (Do  these  calculations  for  all 
of  the  pulse  parameter  data  that  you  have  generated.) 

14.  Determine  which  of  the  nine  corrected  waveforms  has 
parameter  values  closest  to  the  mean  values  calculated 
above;  this  is  the  representative.  Use  this 
representative  measurement  waveform  for  the  report 
plots . 

15.  Plot  the  representative  waveform. 

16.  Calculate  the  uncertainties  in  the  representative 
waveform's  pulse  parameters.  You  may  use  the  limits 
listed  in  Sec.  A.l  for  these  calculations. 

17.  Generate  the  test  report. 
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A . 4 . 4 J itter  Measurement 


1.  Use  the  same  oscilloscope  settings  as  those  for  the 
OUT.  Record  the  time  and  the  room  temperature  and 
relative  humidity. 

2.  Select  the  "Delta  V"  oscilloscope  menu  key.  Turn  the 
voltage  markers  on  and  select  the  measurement  channel 
for  both  markers. 

3.  Press  the  "Auto  Level  Set"  key.  Select  the  "Preset 
Levels  = 50%-50%." 

4.  Record  the  displayed  50%  amplitude  value. 

5.  Select  the  "Histogram"  oscilloscope  menu  key,  "Time 
Histogram,"  and  then  "Window." 

6.  Using  the  oscilloscope  knob,  set  marker  number  2 to  the 
50%  voltage  value. 

7.  Use  the  oscilloscope  knob  to  set  marker  1 to  one 
voltage  increment  above  the  marker-2  voltage  position. 
This  is  usually  approximately  1.5  mV.  Record  the 
voltage  values  of  each  marker. 

8.  Select  the  "Acquire"  oscilloscope  key  and  then  set  the 
"Number  of  Samples"  to  500. 

9.  Press  the  "Start  Acquire"  key. 

10.  When  the  oscilloscope  has  finished  the  measurement, 
press  the  "Results"  key  and  then  the  "Sigma"  key. 

11.  Record  the  displayed  value  of  sigma. 

12.  Repeat  steps  8 through  11  nine  times. 

13.  Calculate  the  mean  and  standard  deviation  of  the  nine 
recorded  values.  Use  the  mean  value  for  the  input  to 
the  GAUSS  program. 
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APPENDIX  B (Software  source  code  listings) 


This  appendix  contains  the  source  code  listing  of  the  programs 
ACQUIRE,  DECON_NIST,  FIXACQ , PULS _P ARAMS , GAUSS,  GD_HISTOGRAM , 
MATH  OPS,  text  out  that  are  used  in  the  AWAMS. 
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B.  1 ACQUIRE 


100!  RE-STQRE  "ACQUIRE:,  1400" 

102  ! 

104  ! 

106  COM  /Interrupts/  INTEGER  Intr  prty 
108  COM /Sys/ Sysjd$[10] 

1 1 0 COM  /Sys  /nsi/  Msijd$[20j 
112  ! 

114  OUTPUT  KBD  USING  "K,#";"SCRATCH  KEY”  ! ERASE  SOFT  KEYS 
1 1 6 CONTROL  KBD,1 5;Q  ! sets  the  colors  of  the  soft  keys 

118  CONTROL  KBD, 2;  1 
120  ! 

122  lntr_prty  = 1 
1 24  CALL  Cal_prog 
126  ! 

128  OUTPUT  KBD  USING  "K,#";"LOAD  KEYE”  ! returns  the  typing  aid  keys 
130  PRINT  TABXYO  ,5);"End  of  program.  Enter  'RUN'  to  repeat." 

132  I 

1 34  END  ! end  of  stub  that  calls  the  Cal_prog  subprogram 

136  ! 

138  !_ 

140  ! 

142  SUB  CaLprog 
144  ! 

146  Datejine:  ! 

150  ! Last  modified  on  20  MAY  91  at  12:00 

152  ! 

154  ! 

156  ! 

158  ! This  is  version  2.0 

160  ! Program  by  S.  M.  Chesnut. 

1 62  ! This  program  uses  all  kinds  of  stuff  written  by  Galen  Koepke 

1 64  ! including  the  following:  Menu_scroll,  Select_disk,Enterfilename, 

166  ! File_menu,  Pause_key_on,  Errortrap,  and  Data_to_disk_r. 

1 68  I Many  thanks  go  to  him  for  the  use  of  these  sub-programs. 

170  ! Without  his  help  and  support,  this  program  would  not  have 

172  ! possible. 

174  ! The  upgrade  to  version  1.0  consisted  of  adding  the  ability 

176  ! to  access  HFS  disks  and  TIMEOUT,  trigger,  and/or  internal 

178  ! step  generator  error  checks. 

180  ! 

182  ! =================================== 

1 84  ! Main  Program 

186  ! =================================== 

188  ! 

1 90  OPTION  BASE  1 

192  DEG 

194  KBD  CMODE  ON 

196  PRINTER  IS  CRT 

198  CLEAR  SCREEN 

200  OFF  KEY 

202  Version$  = "HP  320-12/20/89  version  1.0  subprogram  " 

204  ! 

206  I 

208  GOSUB  Init  variables 
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210  GOSUB  Init_graphics 

212  GOSUB  lnit_mnemonics 

214  GOSUB  Load_averages 

216  GOSUB  Main  cont 

218  ! 

220  ! 

222  Exit:  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 

224  ! 

226  CLEAR  SCREEN 

228  LOCAL  707 

230  ! 

232  IF  Data_set_count  MOD  8<  >0  THEN 

234  PRINTER  IS  PRT 

236  PRINT  CHR$(12) 

238  PRINTER  IS  CRT 

240  END  IF 

242  I 

244  G CLEAR 

246  GINIT 

248  PRINT  Enh_off$ 

250  OFF  KBD  ' 

252  KBD  CMODE  OFF 

254  SUBEXIT  ! exit  the  subprogram 

256  I 

258  I = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 

260  ! INITIALIZATION 

262  ! =================================== 

264  I 

266  lnit_variables:! 

268  ! 

270  COM  /Interrupts/  INTEGER  lntr_prty 

272  COM  /Sys_msi/  Msi_id$[20] 

274  COM  /Sys/  Sys_id$[10] 

276  COM  /Bugs/  INTEGER  Bugl ,Bug2,Bug3, Printer 

278  COM  /Files/ Diskdrive$[20],Filename$[14],Ms_path$[500] 

280  COM  /Hue/  Rev_vid$[1],Enh_off$[1],Underline$[1] 

282  COM  /Hue/  Red$[1],Orange$[1],L_blue$[1] 

284  COM  /Mnu/  INTEGER  lnterruptedfWhich,T_which,V_which,Allowd$(1 2)[1 0] 

286  COM  /Mnu/  INTEGER  Stp 

288  COM  /Scope/  REAL  Time_per_div, Volts, Trange,Vrange,Dly 

290  COM  /Scope/  REAL  Probe_f ac, Offs, Trig, Atten 

292  COM  /Scope/  INTEGER  Aver,Pnts,Chnnl 

294  COM  /Scope/  Type$[30],Refer$[14],@Scope,Mode$[30] 

296  COM  /Tcal_vals/  INTEGER  Zero_x,Ls_prs,Slope,T_aver,REAL  Freq 

298  COM  /Tcal_vals/  Slpe$[1 0],Save$[1 0],REAL  Tc_off,Tc_volt,T_trig 

300  COM  /Vcal_vals/  INTEGER  V aver, Interval, REAL  V_step,V_min 

302  ! 

304  DIM  Version$[80] 

306  ! 

308  Sys_id$  = SYSTEM $(" SYSTEM  ID") 

310  Msi_id$  = SYSTEM$("MSI") 

312  ! 

314  Lastl  =0 

316  IF  Which  = 0 THEN 

318  Which  =1 

320  T_which  = 1 

322  V_which  = 1 

324  GOSUB  Start_vals 
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326 

328 

330 

332 

334 

336 

338 

340 

342 

344 

346 

348 

350 

352 

354 

356 

358 


lvalue  for  the  initial  run. 

lotherwise  stored  in  COM/mnu,  COM/Scope, 

1C0M/Tcal_vals,  and  COMA/cal  vals 

END  IF 
PEN  1 

Beep_flag  = 0 
Stp  = 0 

lnfo_screen$  = "n" 

Local_prty  = Intrprty 
Paused  = 1.3 
Mode$  = "TRIGGERED" 

I 

RETURN 

I 


360  lnit_mneumonics:  I 


362 

364 

366 

368 

370 

372 

374 

376 

378 

380 

382 

384 

386 

388 

390 

392 

394 

396 

398 

400 

402 

404 

406 

408 

410 

412 


I 

I These  are  used  to  change  the  color  with  a PRINT  or  DISP  statement 
! 

Red$  =CHR$n  37) 

Orange$  =CHR$(1 38) 

L_biue$  =CHR$040) 

Rev_vid$  =CHR$(1 29) 

Enh_off$  =CHR$(1 28) 

Underline$  =CHR$(1 32) 

! 

RETURN 


! 

Init_graphics:l 
~ GCLEAR 
GINIT 

Yjdu_max  = 1 00*  MAX(1 , 1 /RATIO) 
X_Qdu_max  = 1 00*MAX(1  .RATIO) 
VIEWPORT  0,X_gdujTiax,0,Y_gdu_max 
WINDOW  0,1000,0,1000 
GRAPHICS  ON 
ALPHA  ON 
RETURN 
I 


I 

420  Start_vals:  ! set-up  default  values 

422  I 

424  IWaveform  variables 

426  I 

428  Trange  = 5.E-9 

430  Timeperdiv  =Trange/1 0 

432  Dly  =6„0E-8 

434  Chnnl  = 2 

436  Pnts  = 128 


416 

418 
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438  Aver  = 64 

440  Vrange  = 4.00E-1 

442  Volts  = Vrange/8 

444  Type$  = "AVERAGE" 

446  Offs  = 1 .90E-1 

448  Atten  = 1 

450  Refer$  = " CENTER  " 

452  Trig  = 1 .00E-1 

454  ! 

456  IVoltage  calibration  default  values. 

458  I 

460  V_aver  = 64 

462  Interval  = 8 

464  V_step  = .05 

466  V_min  = 0. 

468  ! 

470  ITime  calibration  default  values. 

472  ! 

474  Slope  = 1 

476  Freq  = 5.E  + 9 

478  Slpe$  = " + SLOPE  " 

480  Ls_prs  = 1 /(Time_per_div  * Freq)  * Pnts/1 00  + 1 

482  Zero_x  = 2*ls_prs  + 1 

484  T_aver  = 64 

486  Tc_volt  = Volts 

488  T c_off  = Offs 

490  Save$  = " NO  " 

492  ! 

494  RETURN 

496  ! 

498  i******************************************************************* 
500  ! 

502  Load_averages:  ! 

504  Strt:  DATA  " 1 " 

506  DATA  "2" 

508  DATA  "4" 

510  DATA  "8" 

512  DATA  "16" 

514  DATA  "32" 

516  DATA  "64" 

518  DATA  "128" 

520  DATA  "256" 

522  DATA  "512" 

524  DATA  "1024" 

526  DATA  "2048" 

528  RESTORE  Strt 

530  READ  Allowd$(*) 

532  RETURN 

534  ! 

536  |***************************************************************** 
538  ! 

540  ! ****************** ****** ********** 

542  1 

544  Main_cont:  ! 

546  I 

548  Interrupted  = 1 
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550  lntr_prty  = Intrprty  + 1 

552  LOOP 

554  IF  Interrupted  THEN  GOSUB  Mainjnenu 

556  IF  Stp  THEN  GOTO  Retl 

558  ON  KEY  9 LABEL  "EXIT  PROGRAM",Local_prty  + 2 GOTO  Retl 

560  END  LOOP 

562  ! 

564  Retl:  OFF  KEY 

566  Intrprty  = lntr_prty-1 

568  RETURN 

570  f 

572  ! 

574  Main_menu:  ! 

576  Interrupted  = 0 

578  PRINT  Rev_vid$;L_blue$ 

580  PRINT  "Press  the  appropriate  soft  key.";Enh_off$ 

582  ON  KEY  0 LABEL  "WAVEFORM  MENU",Local_prty  + 1 CALL  Wave 

584  ON  KEY  2 LABEL  " TCAL  MENU  ",Local_prty  + 1 CALL  Teal 

586  ON  KEY  4 LABEL  " VCAL  MENU  ",Local_prty  + 1 CALL  Veal 

588  ON  KEY  5 LABEL  " PROGRAM  INFO  \Local_prty  + 1 CALL  Operatorjnfo 

590  RETURN 

592  \ 

596  I 

598  SUBEND 

600  ! 

602  j***«**»**»**'»«#»*e«»*e*e»«e»»»««***®»**«***'**'**'»»*»'**a*'*'»®**»*®®«' 

604  ! 

606  SUB  Wave 
608  Wave:  ! 

610  CLEAR  SCREEN 

612  OPTION  BASE  1 

614  DEG 

616  KBD  CMODE  ON 

618  PRINTER  IS  CRT 

620  OFF  KEY 

622  GOSUB  lnit_vars 

624  GOSUB  Wave  scope 

626  GOSUB  Wave  cont 

628  SUBEXIT 

630  ! 

634  I 

636  lnit_vars:  ! 

638  COM  /Interrupts/  INTEGER  Intr  prty 

640  COM  /Sys_msi/  Msi_id$[20] 

642  COM  /Sys/  Sys_id$[10] 

644  COM  /Bugs/  INTEGER  Bugl  ,Bug2,Bug3, Printer 

646  COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

648  COM  /Hue/  Rev_vid$[1],Enh_off$[1],Underline$[1] 

650  COM  /Hue/  Red$[1],Orange$m,L_blue$l1] 

652  COM  /Mnu/  INTEGER  Interrupted, Which, T which, V_which,Allowd$(*) 

654  COM  /Mnu/  INTEGER  Stp 

656  COM  /Scope/  REAL  Time_per_div,Volts„Trange,Vrange,Dly 

658  COM  /Scope/  REAL  Probe_fac, Offs, Trig, Atten 

660  COM  /Scope/  INTEGER  Aver,Pnts,Chnnl 
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662  COM  /Scope/  Type$[30],Refer$[14],@Scope,Mode$[30] 

664  COM  /Sleet/  INTEGER  Lastl  #Tlast,Vlast 

666  ! 

668  ! 

670  DIM  Version$[80] 

672  DIM  Test$[1 60],Data_id$[40] 

674  DIM  Choice$[15],Ch$[1],Step$[50] 

676  ! 

678  ! 

680  INTEGER  Co_ords(1 2,4),Lwrlftx,Lwrlfty,UpperrtxfUpperrtty 
682  INTEGER  Num_of_choices,What(1 ) 

684  INTEGER  l,J,Pen,Knobcount 

686  INTEGER  Error_flag,Beep_flag(Local_prtycValid,Datacount 

688  INTEGER  Fiiesize,Baddata,Endpoint#Print_val 

690  INTEGER  Yref,Temp,ltem_cnt,Err_flg 

692  ! 

694  ! 

696  REAL  Data_entered,Data_set_count 

698  REAL  Yinc,Yor,Rtemp,Waveform(32767) 

700  DIM  Dp$[80] 

702  DIM  T$[52] 

704  Local_prty  =lntr_prty 

706  Ftype$  ="BDAT" 

708  Filesize  = 500 

710  Lastl  =0 

712  PEN  1 

714  Beep_flag  = 0 

716  Paused  = 1.5 

718  ! 

720  RETURN 

722  ! 

724  !»*»***•**»**•*•*»***•*•**•••»**»*»***»*»**»»•»******»»»********** 
726  ! 

728  Wave_scope:  ! 

730  IThis  returns  the  waveform  menu/scope  values  to  those  in 
732  ! the  common  block  called  Scope. 

734  CALL  Scope_init(Err_flg) 

736  IF  Err_flg  THEN 

738  Wavejntrpt  = 1 

740  Interrupted  = 1 

742  Err_f  Ig  = 0 

744  SUBEXIT 

746  END  IF 

748  CLEAR  707  lelears  the  HPIB  to  the  scope 

750  OUTPUT  @Scope;":TRIGGER:LEVEL  "&VAL$(Trig) 

752  IF  Refer$  = " CENTER  "THEN 

754  OUTPUT  @Scope;"TIMEBASE:REFERENCE  CENTER" 

756  ELSE 

758  OUTPUT  @Scope;"TIMEBASE:REFERENCE  LEFT" 

760  END  IF 

762  OUTPUT  @Scope;":TIMEBASE: DELAY  "&VAL$(Dly) 

764  OUTPUT  @Scope;":TIMEBASE:RANGE  "&VAL$(Trange) 

766  OUTPUT  @Scope;"VIEW  CHANNEL" &VAL$(Chnnl) 

768  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":OFFSET  "&VAL$(Offs) 

770  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":RANGE  "&VAL$(Vrange) 

772  OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(Aver) 
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RETURN 

I 


774 

776 

778 

780 

782 


! 


784  Graphs_ary300:  ! 

786  IThis  routine  fills  the  array  used  by  the  select_graphics 

788  Iroutine.  The  array  contains  the  coordinates  for  the 

790  Irectangles  drawn  in  select_graphics. 

792  lit  the  data  is  all  zeros,  this  is  a null  field  and  is 

794  lused  to  make  all  rows  of  equal  length. 

796  IThese  coordinates  are  for  the  system  300  machines. 

798  First:  DATA  30,943,176,34  11,1 

800  DATA  372,943,176,34  !1, 2 

802  DATA  714,943,220,34  !1, 3 

804  DATA  30,830,176,35  12,1 

806  DATA  372,830,176,35  !2,2 

808  DATA  714,830,220,35  12,3 

810  DATA  30,717,176,35  13,1 

812  DATA  372,717,176,35  !3, 2 

814  DATA  714,717,220,35  S3, 3 

816  DATA  30,604,176,35  14,1 

818  DATA  0,0, 0,0  14,2 

820  DATA  0,0, 0,0  14,3 

822  RESTORE  First 

824  READ  Co_ordsn 

826  Num_of_choices  = 1 2 I total  number  of  on  screen  choices 
828  Rowsize  = 3 

830  RETURN 

832  ! 


836  ! 
838  ! 


#**#########*#####**##*G*e##e##««ttao«**#*#»*****##*#*’*#**»#*#**** 


840  Wavecont:  ! 

842  ! 

844  OFF  KEY 

846  Wavejntrpt  = 1 

848  lntr_prty  = Local_prty  + 1 

850  LOOP 

852  IF  Wavejntrpt  =1  THEN 

854  IF  Sys_id$[1 ,4]  = "S300"  THEN 

856  CONTROL  CRT„5;1 

858  SEPARATE  ALPHA  FROM  GRAPHICS 

860  GOSUB  Graphs_ary300 

862  END  IF 

864  END  IF 

866  IF  (Wavejntrpt  = 1 ) OR  (Wavejntrpt  = 3)  THEN 

868  GOSUB  Background 

870  GOSUB  FilIJn  values 

872  CALL  Select_graphics(Which,Last1  ,Co_ords(*)) 

874  END  IF 

876  IF  Wavejntrpt  THEN  GOSUB  Wave  menu 

878  Interrupted  = 1 

880  ON  KEY  9 LABEL  "EXIT  PROG  RAM ",  Local  jprty  + 2 GOTO  Retl 

882  END  LOOP 

884  Retl:  Stp - 1 IThis  will  cause  the  entire  program  to  end. 
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886 

Interrupted  = 0 

888  Ret2:  OFF  KEY  !This  will  exit  only  this  subprogram. 

890 

CLEAR  SCREEN 

892 

Intr  prty  = Local  prty 

894 

RETURN 

896 

! 

898 

]#*•»*•**•**•*«***«***»****•#•*•****#****•** 

##**«*****#*#**«&* 

900 

! 

902  Wave  menu:  1 

904 

Wave  intrpt  = 0 

906 

OFF  KEY 

908 

OFF  KBD 

910 

OFF  KNOB 

912 

Knobcount  = 0 

914 

DISP  Orange$;"DUT  MENU" 

916 

ON  KBD,Local_prty  + 1 GOSUB  Process_kbd 

918 

ON  KNOB  .01, Local  prty  + 1 GOSUB  Move_pointer 

920 

ON  KEY  1 LABEL  "ACQUIRE  DATA  ",Local  prty  + 1 GOSUB  Take_data 

922 

ON  KEY  7 LABEL  "MANUAL  SETUP  ",Local  prty  + 1 GOSUB  Manual  set 

924 

ON  KEY  5 LABEL  "MAIN  MENU  ",Local  prty+1  GOTO  Ret2 

926 

SELECT  Which 

928 

! 

930 

CASE  1 Ichannel 

932 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 

GOSUB  Sel_chn 

934 

CASE  2 I time 

936 

ON  KEY  3 LABEL  "CHANGE  VALUE",Local  prty+1 

GOSUB  lnput_time 

938 

I 

940 

CASE  3 I averages 

942 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local  prty+1 

GOSUB  Choose  average 

944 

1 

946 

CASE  4 1 voltage 

948 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local  prty  + 1 

GOSUB  lnput_volts 

950 

! 

952 

CASE  5 I delay 

954 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local  prty+1 

GOSUB  lnput_delay 

956 

! 

958 

CASE  6 ! points 

960 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local  prty  + 1 

GOSUB  lnput_data_pnts 

962 

! 

964 

CASE  7 ! offset 

966 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 

GOSUB  lnput_offset 

968 

CASE  8 l delay  reference 

970 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 

GOSUB  lnput_ref 

972 

CASE  9 Itrigger  level 

974 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 

GOSUB  lnput_trig 

976 

CASE  10!  attenuation 

978 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local  prty+1 

GOSUB  lnput_atten 

980 

! 

982 

CASE  ELSE 

984 

GOSUB  Beeps 

986 

DISP  "ERROR  PARAMETER  OUT  OF  RANGE" 

988 

WAIT  Paused 

990 

END  SELECT 

992 

1 

994 

IF  Beep  flag  THEN  BEEP 

996 

! 

B9 


998  RETURN 

1000  ! 

1 002  j*#*******#**************#^*******#fi,**********#******************* 

1004  ! 

1006  Process_kbd:  ! 

1008  Test$  = KBD$ 

1010  IF  LEN(Test$)  = 1 AND  Test$[1,1]<  >CHR${32)  THEN  RETURN 

1012  Wave  Jntrpt  = 2 

1014  IF  Test$[1 ,1  ] =CHR$(32)  THEN 

1016  REPEAT 

1018  IF  Which  < Num_of_choices  THEN 

1020  Which  = Which  + 1 

1022  ELSE 

1024  Which  =1 

1026  END  IF 

1 028  UNTIL  Co_ords(Which(  1 ) < > 0 

1030  CALL  Select_graphics(Which,Last1  ,Co_ords(#)) 

1032  END  IF 

1034  IF  Test${1  f 1 1 < >CHR$(255)  THEN  RETURN 
1036  SELECT  Test$[2, 2] 

1038  CASE  CHR$(255) 

1040  ! do  nothing,  this  is  a CTRL  character 

1042  CASE  "V\"T"  Idown  arrow 

1 044  REPEAT 

1046  IF  Which  < = (Num_of_choices-Rowsize)  THEN 

1048  Which  = Which  + Rowsize 

1050  ELSE 

1 052  Which  = Rowsize-(Num_of_choices-Which) 

1054  END  IF 

1 056  UNTIL  Co_ords(Which,  1 ) < > 0 

1058  CASE  "A","W"  iup  arrow 

1060  REPEAT 

1062  IF  Which  > Rowsize  THEN 

1 064  Which  = Which-Rowsize 

1066  ELSE 

1 068  Which  = Which  + (Num_of_choices-Rowsize) 

1070  END  IF 

1072  UNTIL  Co_ords(Which,  1 ) < > 0 

1074  CASE  "<\"HVf"  lleft  arrow,  prev  key 

1076  REPEAT 

1078  IF  Which>1  THEN 

1080  Which  = Which- 1 

1082  ELSE 

1084  Which  = Num_of_choices 

1086  END  IF 

1 088  UNTIL  Co_ords(Which,  1 ) < > 0 

1090  CASE  ">","0",","  Iright  arrow,  next  key 

1 092  REPEAT 

1094  IF  Which  <Num_of_choices  THEN 

1096  Which  = Which  +1 

1098  ELSE 

1 1 00  Which  = 1 

1102  END  IF 

1104  UNTIL  Co_ords(Which,1)<  >0 

1106  CASE  ELSE 

1108  BEEP  80., .1 


BIO 


1110  END  SELECT 

1112  CALL  Select_graphics(Which,Last1  ,Co_ords(*)) 

1114  RETURN 

1116  ! 

1 1 18  i****************************************1************************ 

1120  ! 

1 1 22  Move_pointer:  ! 

1 1 24  Knobcount  = Knobcount  + KNOBX-KNOBY 

1126  IF  ABS(Knobcount)  < 1 5 THEN  RETURN 

1128  Wavejntrpt  = 2 

1 1 30  REPEAT 

1132  IF  Knobcount  > 0 THEN 

1134  Which  = Which +1 

1136  ELSE 

1138  Which  = Which-1 

1140  END  IF 

1142  IF  Which  < 1 THEN  Which  = Num_of_choices 

1144  IF  Which  > Num_of_choices  THEN  Which  = 1 

1 1 46  UNTIL  Co_ords(Which,  1 ) < > 0 

1148  CALL  Select_graphics(Which,Last1  ,Co_ords(#)) 

1150  Knobcount  = 0 

1152  RETURN 

1154  ! 

1156  |*****####*********##***********#***44*4**##********************** 
1158  ! 

1 1 60  Background:  I 

1162  I 

1 1 64  CLEAR  SCREEN 

1166  IF  Sy s jd $ [ 1 ,4]  = "S300"  THEN 

1168  MERGE  ALPHA  WITH  GRAPHICSIThis  gives  back  the  colors  to  the  alpha 

1170  Iplane. 

1172  END  IF 

1174  PRINT  TABXY(1 ,1  );Rev_vid$;L_blue$;"  CHANNEL  ";Enh_off$; 

1176  PRINT  TABXY(1 ,4);Rev_vid$;L_blue$;"  VOLTS/DIV  (v)  ";Enh_off$; 

1178  PRINT  TABXY(1 ,7);Rev_vid$;L_blue$;"  OFFSET  (v)  ";Enh_off$; 

1180  PRINT  TABXY(1 ,10);Rev_vid$;L_blue$;"  ATTENUATION  ";Enh_off$; 

1182  PRINT  TABXY(30,1  );Rev_vid$;L_blue$;"  TIME/DIV  (s)  ";Enh_off$; 

1184  PRINT  TABXY(30,4);Rev_vid$;L_blue$;"  DELAY  (s)  ";Enh_off$; 

1186  PRINT  TABXY(30,7);Rev_vid$;L_blue$;"  DELAY  REFER.  ";Enh_off$; 

1188  PRINT  TABXY(59f  1 );Rev_vid$;L_blue$;"  # OF  AVERAGES  ";Enh_off$; 

1190  PRINT  TABXY(59,4);Rev_vid$;L_blue$;"  # OF  POINTS  ";Enh_off$; 

1192  PRINT  TABXY(59,7);Rev_vid$;L_blue$;"  TRIGGER  LEVEL  (v)  ";Enh_off$; 

1194  RETURN 

1196  ! 

1200  ! 

1 202  Fill_in_values:  ! 

1 204  GOSUB  Print_chnnl 

1206  GOSUB  Print_time 

1208  GOSUB  Print  volts 

1210  GOSUB  Print_pnts 

1212  GOSUB  Print_ave 

1214  GOSUB  Print_delay 

1216  GOSUB  Print_ref 

1218  GOSUB  Print_offset 

1 220  GOSUB  Print__trig_lev 


Bll 


GOSUB  Print_atten 
RETURN 

********#*#****#*****#**«e>#«#******e*»*#«*»e**e£«***ft*********e* 


Data  input  subroutines 


#*####*##**####*###***##*#########*#*##*###**##**#####*#*#*##*#* 


1 248  Choose_average:  ! 

1250  OFF  KEY 

1252  OFF  KNOB 

1254  OFF  KBD 

1256  CLEAR  SCREEN 

1258  GCLEAR 

1 260  PRINT  L_blue$ 

1262  Dp$  = "Select  Average  " 

1264  T$ -"Available  Averages  (powers  of  2 ) " 

1 266  lntr_prty  - lntr_prty  + 3 

1268  CALL  Menu_scroll(Dp$,T$,Allowd$(*),1 2,1  ,What(*)) 

1 270  lntr_prty  = lntr_prty-3 

1272  IF  What(1)<  >0  THEN  ! Aborted 

1274  Aver  = VAL(Allowd$(What(1 ))) 

1276  END  IF 

1278  Wave_intrpt  = 3 

1280  I 

1282  OUTPUT  @Scope;":ACQUIRE:TYPE  AVERAGE" 

1284  OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(Aver) 

1286  RETURN 

1 288  Print_ave:  I 

1290  PRINT  TABXY(64,2);Orange$; 

1 292  CALL  Auto_format(Aver*  1 .0) 

1294  RETURN 

1296  I 

1298  ! 

1 300  j*#**###*#*»***'*#***'»*#***®***#*#*'6*'e6*®*®®**'*'****6'B,<>'B'*®**',f**'6®'*'*fl' 
1302  I 

1 304  Chnnl_error:  I 
1 306  BEEP 

1308  DISP  "Input  out  of  range  or  disallowed  value." 

1310  WAIT  Paused 

1312  DISP  "Try  again  ..." 

1314Se!_chn:  I 

1316  ON  ERROR  GOTO  Chnnl  error 

1318  Test$  = "" 

1320  INPUT  "Enter  the  acquisition  channel  number  (1-4)„",Test$ 

1322  IF  LEN(Test$)<  1 THEN  RETURN 

1324  Temp  = VAL(Test$| 

1326  OFF  ERROR 

1328  IF  (Temp  < 1 ) OR  (Temp  >4)  THEN  GOTO  Chnnl  error 
1330  OUTPUT  @Scope;"BLANK  CHANNEL" &VAL$(Chnnl) 

1332  Chnnl  =Temp 


1222 
1224 
1226  ! 
1228  ! * 
1230  I 
1232 
1234 
1236 
1238 
1240 
1242  ! 
1244  !* 
1246  ! 
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1334 

1336 

1338 

1340 

1342 

1344 

1346 

1348 

1350 

1352 

1354 

1356 

1358 

1360 

1362 

1364 

1366 

1368 

1370 

1372 

1374 

1376 

1378 

1380 

1382 

1384 

1386 

1388 

1390 

1392 

1394 

1396 

1398 

1400 

1402 

1404 

1406 

1408 

1410 

1412 

1414 

1416 

1418 

1420 

1422 

1424 

1426 

1428 

1430 

1432 

1434 

1436 

1438 

1440 

1442 

1444 


GOSUB  New_channl 
Print_chnnl:  ! 

PRINT  TABXY(3,2);Orange$; 

CALL  Auto_format(Chnnl*  1 .0) 

IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  ,Co_ords(*)) 
RETURN 


! 


j##»*e**«««*«****ft*«**»*****#**#**«*****#**«*«*«e***«*«*«**#«*«*«fi> 

! 

New_channl:  ! 

IThis  sets  the  values  for  the  channel  just  selected 
!to  the  current  values. 

OUTPUT  @Scope;":TRIGGER:LEVEL  "&VAL$(Trig) 

IF  Refer$  = " CENTER  " THEN 

OUTPUT  @Scope;"TIMEBASE:REFERENCE  CENTER" 

ELSE 

OUTPUT  @Scope;"TIMEBASE:REFERENCE  LEFT" 

END  IF 

OUTPUT  @Scope;":TIMEBASE:DELAY  "&VAL$(Dly) 

OUTPUT  <g>Scope;":TIMEBASE:RANGE  "&VAL$(Trange) 

OUTPUT  @Scope;"VIEW  CHANNEL" &VAL$(Chnnl) 

OUTPUT  @Scope;":CHANNEL"&VAL${Chnnl)&":OFFSET  "&VAL$(Offs) 

OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":RANGE  "&VAL$(Vrange) 

OUTPUT  @Scope;":ACQUIRE:TYPE  "&Type$ 

OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(Aver) 

OUTPUT  @Scope;":ACQUIRE:POINTS  "&VAL$(Pnts) 

OUTPUT  @Scope;":ACQUIRE:BANDWIDTH  HIGH" 

RETURN 

! 

! 

! 

Input_data_pnts:  ! 

OFF  KEY 
OFF  KBD 
OFF  KNOB 
CLEAR  SCREEN 
GCLEAR 
PRINT  L_blue$ 

DIM  Points$(5)[20] 

Dp$  = " Select  Points  " 

T$  ^"Available  Points  for  the  selected  sweep  speed." 

IF  (Time_per_div  > = 1 .E-1 1 ) AND  (Time_per_div<2.E-1 1)  THEN 
ltem_cnt  = 2 
REDIM  Points$(2) 

Frst:  DATA  "100" 

DATA  "400" 

RESTORE  Frst 
READ  Points $(*) 

END  IF 

IF  (Time_per_div > =2.0E-1 1)  AND  (Time_per_div<5.E-1 1 ) THEN 
Itemcnt  = 3 
REDIM  Points$(3) 

Secnd:  DATA  "100" 

DATA  "400" 

DATA  "500" 


B13 


1446 

1448 

1450 

1452 

1454 

1456 

1458 

1460 

1462 

1464 

1466 

1468 

1470 

1472 

1474 

1476 

1478 

1480 

1482 

1484 

1486 

1488 

1490 

1492 

1494 

1496 

1498 

1500 

1502 

1504 

1506 

1508 

1510 

1512 

1514 

1516 

1518 

1520 

1522 

1524 

1526 

1528 


RESTORE  Secnd 
READ  Points$(*) 

END  IF 

IF  (Time_per_div  > = 5.0E-1 1 ) AND  (Time_per_div<2.0E-10)  THEN 
REDIM  Points$(3) 
ltem_cnt  = 3 
Thrd:  DATA  "100" 

DATA  "500" 

DATA  " 1 000" 

RESTORE  Thrd 
READ  Points$(*) 

END  IF 

IF  (Time_per_div  > = 2.00E-10)  AND  (Time_per_div  < = 1 .0)  THEN 
ltem_cnt  = 5 
REDIM  Points$(5) 

Frth:  DATA  "128" 

DATA  "256" 

DATA  "500" 

DATA  "512" 

DATA  "1024" 

RESTORE  Frth 
READ  Points$n 
END  IF 

lntr_prty  = lntr_prty  + 3 

CALL  Menu_scroll(Dp$,T $,Points$P ),ltem_cnt,  1 ,What(* )) 
lntr_prty  = !ntr_prty-3 
IF  WhatIDoO  THEN  ! Aborted 
Pnts  = VAL(Pomts$(What(1 ))) 

END  IF 

Wave  Jntrpt  = 3 
! 

OUTPUT  @Scope;":ACQUIRE:TYPE  AVERAGE" 

OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(Pnts> 

RETURN 
Prlnt_pnts:  I 

PRINT  TABXY(64,5);Orange$; 

CALL  Auto_format(Pnts*  1 .0) 

IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  fCo_ords(*)) 
RETURN 

! 


1 530  Volterr:  I 

1532  GOSUB  Beeps 

1534  DISP  "ERROR  IN  READING  VALUE  OR  VALUE  OUT  OF  RANGE,  TRY  AGAIN." 
1536  WAIT  Paused 

1 538  lnput_volts:  I 

1 540  ON  ERROR  GOSUB  Volterr 

1542  Test$  = "" 

1544  INPUT  "Enter  the  volts  per  division  in  volts  ,..",Test$ 

1546  IF  LEN(Test$) < 1 THEN  RETURN 
1 548  GOSUB  Data  check 

1550  IF  (Rtemp < (Atten* .001 ))  OR  (Rtemp  XAtten8. 080))  THEN  GOTO  Volterr 
1552  Volts  = Rtemp 

1554  Vrange  = Volts  *8 

1556  OUTPUT  707;":CHANNEL"&VAL$(Chnnl)&":RANGE  "&VAL$(Vrange) 
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1558  OFF  ERROR 

1 560  Print_volts:  ! 

1 562  PRINT  TABXYd  ,5);Orange$; 

1 564  CALL  Auto_format(Volts) 

1566  IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  ,Co_ords(*)) 

1568  RETURN 

1570  ! 

1572  !* ********** ****************** 

1574  ! 

1576  Offset_err:  ! 

1578  GOSUB  Beeps 

1 580  DISP  "ERROR  IN  READING  VALUE  OR  VALUE  OUT  OF  RANGE,  TRY  AGAIN." 

1 582  WAIT  Paused 

1 584  lnput_offset:  ! 

1586  ON  ERROR  GOTO  Offset_err 

1588  Test$  = "" 

1590  INPUT  "Enter  the  offset  in  volts  ...",Test$ 

1592  IF  LEN(Test$)<  1 THEN  RETURN 

1594  GOSUB  Data_check 

1596  IF  ABS(Rtemp)  > 5.00E-1  THEN  GOTO  Offset_err 

1598  Offs  = Rtemp 

1600  OUTPUT  707;":CHANNEL"&VAL$(Chnnl)&":OFFSET  "&VAL$(Offs) 

1 602  OFF  ERROR 

1604  Print_offset:l 

1 606  PRINT  TABXYd  ,8);Orange$; 

1 608  CALL  Auto_format(Offs) 

1610  IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  ,Co_ords(*)) 

1612  RETURN 

1614  ! 

1616  !** ***** ******* **,.*«.*•**..**..****** 

1618  ! 

1 620  Atten_err:  ! 

1622  GOSUB  Beeps 

1624  DISP  "ERROR  IN  READING  VALUE  OR  VALUE  OUT  OF  RANGE,  TRY  AGAIN." 

1 626  WAIT  Paused 

1 628  lnput_atten:  ! 

1630  ON  ERROR  GOTO  Atten  err 

1632  Test$  = "" 

1634  INPUT  "Enter  the  channel  attenuation  factor.. .",Test$ 

1636  IF  LEN(Test$)<  1 THEN  RETURN 

1 638  GOSUB  Data_check 

1640  IF  (Rtemp<1.0)  OR  (Rtemp>1000)  THEN  GOTO  Atten  err 

1642  Atten  = Rtemp 

1644  OUTPUT  707;" :CHANNEL" &VAL$  (Chnnl)&"  :PROBE  "&VAL$(Atten) 

1 646  OFF  ERROR 

1 648  Print_atten:  ! 

1650  PRINT  TABXY(3,1 1 );Orange$; 

1 652  CALL  Auto_format(Atten) 

1654  IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  ,Co_ords(*)) 

1656  RETURN 

1658  ! 

1660  i***************************************************************** 
1662  ! 

1 664  Time_err:  ! 

1666  INTEGER  Pnterr 

1668  ! 
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1670  Pnterr  = 0 

1672  GOSUB  Beeps 

1674  DISP  "ERROR  IN  READING  VALUE  OR  VALUE  OUT  OF  RANGE,  TRY  AGAIN." 

1676  WAIT  Paused 

1678  lnput_time:  ! 

1 680  ON  ERROR  GOSUB  Time_err 

1682  Test$  = "" 

1684  Temp  = Pnts 

1686  INPUT  "Enter  the  time  per  division  in  seconds  „..",Test$ 

1688  IF  LEN(Test$)<  1 THEN  RETURN 

1690  GOSUB  Data_check 

1 692  IF  (Rtemp  < 1 .OE-1 1 ) OR  (Rtemp  > 1 ) THEN  GOTO  Time_err 
1 694  Timeperdiv  = Rtemp 

1696  Trange  = 10*Time_per_div 

1698  Rtemp  = Dly 

1700  OUTPUT  707;"TIMEBASE:  RANGE  ”&VAL$(Trange) 

1702  OUTPUT  707;":TIMEBASE:DELAY?" 

1704  ENTER  707 ;Dly 

1 706  IF  Rtemp  < > Dly  THEN 

1708  GOSUB  Beeps 

1710  DISP  "The  delay  value  is  out  of  range.  Delay  set  to  ",Dly,"." 

1712  GOSUB  Print  delay 

1714  WAIT  Paused 

1716  DISP  Orange$;"DATA  MENU  " 

1718  END  IF 

1720  OFF  ERROR 

1722  IF  (Time_per_div > = 1 .E-1 1 ) AND  (Time_per_div<2.E-1 1 ) THEN 
1724  SELECT  Pnts 

1726  CASE  100,4001  do  nothing  these  are  valid  choices. 

1728  CASE  ELSE 

1730  Pnts  = 400 

1732  Pnterr=1 

1734  END  SELECT 

1736  END  IF 

1738  IF  (Time_per_div>  =2.0E-1 1 ) AND  (Time_per_div < 5. E-1 1 ) THEN 
1740  SELECT  Pnts 

1742  CASE  100,400,500!  do  nothing,  these  are  valid  selections. 

1744  CASE  ELSE 

1746  Pnts  = 500 

1748  Pnterr=1 

1750  END  SELECT 

1752  END  IF 

1754  IF  (Time_per_div > = 5.0E-1 1 ) AND  (Time_per_div<2.0E-10)  THEN 
1756  SELECT  Pnts 

1758  CASE  100,500,1000!  do  nothing,  these  are  valid  selections. 

1760  CASE  ELSE 

1762  Pnts  = 1000 

1764  Pnterr=1 

1766  END  SELECT 

1768  END  IF 

1770  IF  (Time_per_div > = 2.00E-1 0)  AND  (Time_per^div < = 1 .0)  THEN 
1772  SELECT  Pnts 

1774  CASE  128,256,500,512,1024!  do  nothing,  these  are  valid  selections. 

1776  CASE  ELSE 

1778  Pnts  = 1024 

1780  Pnterr=1 
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1782  END  SELECT 

1784  END  IF 

1786  IF  Pnterr  THEN 

1788  BEEP 

1790  DISP  "The  number  of  points  has  been  changed  to  the  highest  allowed  value." 

1792  WAIT  Paused 

1794  DISP  "Re-select  the  number  of  points  if  this  is  not  okay." 

1796  WAIT  Paused 

1798  DISP  Orange $;" DATA  MENU  " 

1 800  END  IF 

1802  OUTPUT  707;"ACQ:POIN  "&VAL$(Pnts) 

1 804  GOSUB  Print_pnts 

1 806  Print_time:  I 

1808  PRINT  TABXYI3 1 ,2);Orange$; 

1810  CALL  Auto_format(Time_per_div) 

1812  IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  fCo_ords(*)) 

1814  RETURN 

1816  I 

1818  i*******************'6’********************************************** 
1820  ! 


1822  Delay_error:l 
1824  CLEAR  SCREEN 

1826  OFF  KEY 

1828  OFF  KNOB 

1830  OFF  KBD 

1832  Wavejntrpt  = 3 

1834  GOSUB  Beeps 

1 836  PRINT  "The  delay  value  is  not  valid  for  the  current" 

1838  PRINT  "time  window.  The  scope  default  value  is  ";Dly;"." 

1 840  Again:  ! 

1842  PRINT  "Your  options  are  to:" 

1844  PRINT  "A)  or  <enter>  accept  the  default  value," 

1846  PRINT  "B)  change  the  time  window  to  an  appropriate  value," 
1848  PRINT  "C)  change  the  delay." 

1850  INPUT  "Type  the  letter  corresponding  to  your  desire. ..",Choice$ 

1852  IF  LEN(Choice$)<  1 THEN  RETURN 

1854  SELECT  Choice  $ 

1856  CASE  "A\"a" 

1858  IDo  nothing,  accept  scope  value. 

1860  CASE  "B","b" 

1862  Pnts  = Temp 

1 864  GOSUB  Input  time 

1866  GOSUB  Chk  d 

1868  CASE  "C\"c" 

1870  GOSUB  Input  delay 

1872  CASE  ELSE 

1874  CLEAR  SCREEN 

1876  GOSUB  Beeps 

1878  PRINT  "That  is  not  an  option.  Try  again" 

1880  Choice$  = "" 

1882  GOTO  Again 

1 884  END  SELECT 

1886  RETURN 

1 888  Read_delay_err:  ! 

1890  GOSUB  Beeps 

1892  DISP  "ERROR  IN  READING  DELAY,  TRY  AGAIN." 
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1 894  WAIT  Paused 

1 896  lnput_delay:  ! 

1 898  ON  ERROR  GOTO  Read_delay_err 

1900  Test$  = "" 

1902  INPUT  "Enter  the  desired  delay  time."»Test$ 

1904  IF  LEN(Test$)  < 1 THEN  RETURN 

1906  GOSUB  Data_check 

1 908  OFF  ERROR  " 

1910  Chk_d:OUTPUT  707;":TIMEBASE:DELAY  B&VAL$(Rtemp) 

1912  OUTPUT  707;" :TIMEBASE:DELAY?" 

1914  ENTER  707;Dly 

1916  IF  RtempoDly  THEN 

1918  GOSUB  Delay_error 

1920  END  IF 

1 922  Print_delay:  I 

1 924  PRINT  TABXYI31  t5);0range$; 

1 926  CALL  Auto  format(Dly) 

1928  IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  ,CojHds(*)) 

1930  RETURN 

1932  ! 

1936  I 


1 938  lnput_ref:  ! 

1940  IF  Refer$  = " CENTER  "THEN 
1942  Refer$  = " LEFT  " 

1 944  OUTPUT  @Scope;"TIMEBASE:REFERENCE  LEFT" 

1946  ELSE 

1948  Refer$  ="  CENTER  " 

1 950  OUTPUT  @Scope;"TIMEBASE:REFERENCE  CENTER" 

1952  END  IF 

1954  OUTPUT  @Scope;"TIMEBASE:DELAY?" 

1956  ENTER  @Scope;Dly 

1958  GOSUB  Print_delay 

1 960  Print_ref:  I 

1 962  IF  (Refer$  = "left")  OR  (Refer$  = "LEFT")  THEN 
1964  Refer$  = " LEFT  " 

1966  END  IF 

1968  IF  (Refer$  = "cent")  OR  (Refer$  = "CENT")  THEN 
1970  Refer$  = " CENTER  " 

1972  END  IF 

1974  PRINT  TABXY(30,8);Orange$; 

1976  PRINT  Refer$ 

1978  IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  fCo_ords(#)) 

1980  RETURN 

1982  ! 

1 984  j***************************************************************** 
1986  ! 

1 988  Trig_lev_err:  I 

1990  GOSUB  Beeps 

1992  DISP  "ERROR  IN  READING  DELAY,  TRY  AGAIN." 

1 994  WAIT  Paused 

1 996  lnput_trig:  I 

1998  ON  ERROR  GOTO  Trigjev_err 

2000  Test$  = "" 

2002  INPUT  "Enter  the  desired  trigger  level  in  volts. "»Test$ 

2004  IF  LEN(Test$)  < 1 THEN  RETURN 


B18 


2006  GOSUB  Data_check 

2008  IF  Rtemp  < -1 . OR  Rtemp  > 1 . THEN 

2010  GOSUB  Beeps 

2012  DISP  Red $;" VALUE  OUT  OF  RANGE";Enh_off$;"Try  again." 

2014  WAIT  1.5 

2016  GOTO  lnput_trig 

2018  END  IF 

2020  Trig  = Rtemp 

2022  OUTPUT  @Scope;":TRIGGER:LEVEL  "&VAL$(Trig) 

2024  OFF  ERROR 

2026  Print_trig_lev:  ! 

2028  PRINT  TABXY(60,8);Orange$; 

2030  CALL  Auto_format(Trig) 

2032  IF  NOT  (Wavejntrpt)  THEN  CALL  Select_graphics(Which,Last1  ,Co_ords(*)) 

2034  RETURN 

2036  ! 

2038  i***************************************************************** 
2040  ! 

2042  Manual_set:  ! 

Ithis  allows  the  operator  to  manually  set  up  the  scope. 

CLEAR  SCREEN 
OFF  KNOB 
OFF  KBD 
OFF  KEY 
Wavejntrpt  = 3 

DISP  "The  current  channel  number  is",Chnnl 
WAIT  Paused 

INPUT  "Is  this  the  correct  channel  ? Y/N  ",Ch$ 

IF  (Ch$  = "n")  OR  (Ch$  = "N")  THEN  GOSUB  Get_chn 
PRINT  TABXY(1 ,1  );"Please  set  up  the  waveform  and 
PRINT  "press  continue  when  done." 

LOCAL  707 
PAUSE 

GOSUB  Read  scope  set 
RETURN 

2080  ! 

2082  Chnl_err:  ! 

2084  BEEP 

2086  DISP  "Input  out  of  range  or  disallowed  value." 

2088  WAIT  Paused 

2090  DISP  "Try  again  ..." 

2092  Get_chn:  ! 

2094  ON  ERROR  GOTO  Chnnl_error 

2096  Test$  = "" 

2098  INPUT  "Enter  the  acquisition  channel  number  (1-4).",Test$ 

2100  IF  LEN(Test$)<  1 THEN  RETURN 

2102  Temp  = VAL(Test$) 

2104  OFF  ERROR 

2106  IF  (Temp  < 1 ) OR  (Temp  > 4)  THEN  GOTO  Chnnl  error 
2108  OUTPUT  @Scope;" BLANK  CHANNEL" &VAL$(Chnnl) 

2110  Chnnl=Temp 

2112  OUTPUT  @Scope;"VIEW  CHANNEL" &VAL$(Chnnl) 

2114  OUTPUT  @Scope;":ACQUIRE:POINTS  "&VAL$(Pnts) 

2116  ! The  number  of  point  can  only  be  changed  from  the  controller. 


2044 
2046 
2048 
2050 
2052 
2054 
2056 
2058 
2060 
2062 
2064 
2066 
2068 
2070 
2072 
2074 
2076  ! 
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RETURN 


2118 
2120  I 
2122  I 
2124  ! 

2126  Read  scp_err:  ! 

2128  BEEP 

2130  DISP  "ERROR  IN  READING  SCOPE.  WILL  TRY  Again" 

21 32  Read_scope_set:  I 

2134  ON  ERROR  GOTO  Read_scp_err 

2136  OUTPUT  @Scope;"ACQUIRE:TYPE?" 

2138  ENTER  @Scope;Type$ 

2 1 40  OUTPUT  @Scope;"ACQUIRE:COUNT?" 

2142  ENTER  @Scope;Aver 

2144  OUTPUT  @Scope;":TIMEBASE:DELAY?" 

2146  ENTER  @Scope;DIy 

2148  OUTPUT  @Scope;":TIMEBASE:RANGE?" 

2150  ENTER  @Scope;Trange 

2152  Time_per_div  = Trange/10. 

2 1 54  OUTPUT  @Scope;" :TIMEBASE:REFERENCE?" 

2156  ENTER  (®Scope;Refer$ 

2158  OUTPUT  @Scope;":CHANNEL"&VAL$«Chnnl)&":RANGE?" 

2160  ENTER  #Scope;Vrange 

2162  Volts- Vrange/8 

2164  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":OFFSET?" 

2166  ENTER  @Scope;Offs 

2168  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":PROBE?" 

2170  ENTER  @Scope;Atten 

2172  OUTPUT  @Scope;":TRIGGER:LEVEL?" 

2174  ENTER  @Scope;Trig 

2176  OFF  ERROR 

2178  RETURN 

2180  I 

2182  !**** *##*♦*..*.**  * »***.*..*»« 

2184  I 

2186  Take_data:  ! 

2188  Kiil_meas  = 0 

2190  Dojneas  = 1 

2192  OFF  KEY 

2194  OFF  KBD 

2196  OFF  KNOB 

2198  WHILE  NOT  (Kill_meas)  AND  (Dojneas) 

2200  ON  KEY  0 LABEL  " ABORT  ".LocaLprty  + 5 GOTO  Abort^meas 

2202  IF  Dojneas  THEN  GOSUB  Get_wave 

2204  END  WHILE 

2206  IF  NOT  (Killjneas)  THEN 

2208  OFF  KEY 

2210  GOSUB  Con_to_volts 

2212  INPUT  "Enter  data  description,  40  chrs  or  less.  ",Data_id$ 

2214  Intrjprty  = Localprty  + 1 

2216  CALL  Data_to_disk  r(1  ,INT(Pnts),Voltage(#),Data_id$) 

22 1 8 lntr_prty  = Localprty 

2220  DEALLOCATE  Voltage!*) 

2222  END  IF 

2224  Wave_intrpt  = 3 

2226  RETURN 

2228  ! 
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*###*****##******####***###**#*#**#****************************** 


2230  I 
2232  ! 


2234  Abort  meas:  ! 


2236 

2238 

2240 

2242 

2244 

2246 

2248 

2250 

2252 

2254 

2256 

2258 

2260 

2262 

2264 

2266  ! 

2268  !* * 

2270  ! 


CLEAR  @Scope 
LOCAL  @Scope 
Killmeas  = 1 
CLEAR  SCREEN 
GOSUB  Beeps 

DISP  Red$;"MEASUREMENT  ABORTED " ;Enh_of f $ 

OFF  KEY 

OFF  KNOB 

OFF  KBD 

OFF  ERROR 

OFF  TIMEOUT  7 

CALL  Scope_init(Err_flg) 

IF  Err_flg  THEN  Interrupted  = 1 

Wavejntrpt  = 3 

RETURN 


#t*#*«*t#«t*tt«*#*t»*t«tt*t#ttt**t*t»*e#***t*««*t*t*t*«»******* 


2272  Data_error:  ! 

2274  BEEP 

2276  DISP  "ERROR  IN  READING  SCOPE.  WILL  TRY  AGAIN" 

2278  Get  wave:  ! 

2280  Do_meas  = 0 

2282  Try_again  = 1 

2284  IF  NOT  (Kill_meas)  THEN 

2286  ON  ERROR  GOTO  Data^error 

2288  OUTPUT  @Scope;"#CLS" 

2290  WAIT  1 

2292  OUTPUT  @Scope;":TER?” 

2294  ENTER  @Scope;Ter$ 

2296  OUTPUT  @Scope;":NETWORK:REFLECTION:STEP?" 

2298  ENTER  @Scope;Step$ 

2300  IF  (VAL{Ter$)  < > 1 ) AND  (TRIM$(Step$)  = "OFF")  THEN 

2302  GOSUB  Beeps 

2304  DISP  "No  signal  detected;  please  check  the  setup." 

2306  WAIT  2 

2308  CLEAR  SCREEN 

2310  OFF  KEY 

2312  OFF  KNOB 

2314  OFF  KBD 

2316  OFF  ERROR 

2318  CALL  Scopejnit(Err  flg) 

2320  IF  Err_flg  THEN  Interrupted  = 1 

2322  Wavejntrpt  = 3 

2324  SUBEXIT 

2326  END  IF 

2328  DISP  "System  busy...." 

2330  OUTPUT  @Scope;":TIMEBASE:DELAY  "&VAL$(Dly) 

2332  OUTPUT  @Scope;":TIMEBASE:RANGE  "&VAL$(Trange) 

2334  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":OFFSET  "&VAL$(Offs) 

2336  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":RANGE  "&VAL$(Vrange) 

2338  OUTPUT  @Scope;":ACQUIRE:TYPE  AVERAGE" 

2340  OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(Aver) 
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2342 

2344 

2346 

2348 

2350 

2352 

2354 

2356 

2358 

2360 

2362 

2364 

2366 

2368 

2370 

2372 

2374 

2376 

2378 

2380 

2382 

2384 

2386 

2388 

2390 

2392 

2394 

2396 

2398 

2400 

2402 

2404 

2406 

2408 

2410 

2412 

2414 

2416 

2418 

2420 

2422 

2424 

2426 

2428 

2430 

2432 

2434 

2436 

2438 

2440 

2442  ! 

2444  ! 

2446  ! 


OUTPUT  @Scope;":ACQUIRE:POINTS  "&VAL$(Pnts) 

OUTPUT  @Scope;"*CLS" 

OUTPUT  @Scope;"*SRE  32/ESE  1" 

OUTPUT  @Scope;":DlGITIZE  CHAN"&VAL$(Chnnl)&";*OPC" 

I The  following  loop  allows  for  a keyboard  abort  key  to  be  processed 
! before  completion  of  the  DIGITIZE  command. 

WHILE  NOT  BIT(Stat,5) 

Stat  = SPOLL(@Scope) 

END  WHILE 

OUTPUT  @Scope;":SYSTEM:HEADER  OFF;:EOI  ON" 

OUTPUT  @Scope;"WAVEFORM:SOURCE  WMEMORY"&VAL$(Chnnl)&";  FORMAT  WORD" 
OUTPUT  @Scope;"WAVEFORM:DATA?" 

ENTER  ©Scope  USING  "#,A,D";Header$,Bytes 
IF  Bytes  = 3 THEN 

ENTER  @Scope  USING  "#,3D";Length 
END  IF 

IF  Bytes  = 4 THEN 

ENTER  ©Scope  USING  "#,4D";Length 
END  IF 

Length = Length/2 
IF  Pnt§<>  Length  THEN 

DISP  "The  scope  will  not  allow  ".Pnts/ points.” 

WAIT  Paused 

DISP  "The  number  of  points  is  now  ".Length/.” 

WAIT  Paused 
Pnts  = Length 
END  IF 

REDIM  Waveform  (Length) 

ENTER  @Scope  USING  "#,W";WaveformD 
ENTER  @Scope  USING  ”-K,B";End$ 

OUTPUT  @Scope;" : WAVEFORM: YINCREMENT?” 

ENTER  @Scope;Yinc 

OUTPUT  @Scope;":WAVEFORM:YORIGIN?" 

ENTER  @Scope;Yorg 

OUTPUT  @Scope;" : WAVEFORM:YREFERENCE?" 

ENTER  @Scope;Yref 

OUTPUT  @Scope;":WAVEFORM:XINCREMENT?" 

ENTER  @Scope;Xinc 

OUTPUT  @Scope;":WAVEFORM:XORIGIN?" 

ENTER  @Scope;Xorg 

OUTPUT  @Scope/:WAVEFORM:XREFERENCE?" 

ENTER  ©Scope;Tref 
OFF  ERROR 
IF  Bugl  THEN 

FOR  I = 1 TO  Pnts 
PRINT  Waveform(l) 

NEXT  I 
END  IF 
END  IF 
RETURN 


2448  Con_to_volts:  ! 

2450  ALLOCATE  Voltage(Pnts,2) 

2452  FOR  1 = 1 TO  Pnts 
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2454  Voltage(l,2)  = ((Waveform(l)-Yref)*Yinc)  + Yorg 

2456  Voltage(l,1 ) = ((1-1 ) * Xinc) 

2458  NEXT  I 

2460  RETURN 

2462  I 

2464  !**•* 

2466  ! 

2468  Data_check:  ! 

2470  ! The  following  is  a test  of  the  lower  case  e in  a number  of 

2472  ! scientific  notation.  If  a lower  case  e occurs,  it  is  converted 

2474  ! to  upper  case.  That  is  all. 

2476  IF  POS(Test$,"e")  THEN 

2478  Temp  = POS(Test$,"e") 

2480  Test$[Temp]  = "E"&Test$[Temp  + 1 ,LEN(Test$)] 

2482  END  IF 

2484  ! end  of  lower  case  conversion 

2486  Rtemp  = VAL(Test$) 

2488  RETURN 

2490  ! 

2492  !*»••*******♦•** «#**♦*###**#****##**********. 

2494  ! 

2496  Beeps:  I 

2498  BEEP  400, .25 

2500  BEEP  600,. 50 

2502  BEEP  400, .25 

2504  RETURN 

2506  ! 

2508  SUBEND 
2510  ! 

2512  ! ************************************************************ 

2514  ! 

2516  SUB  Veal 

2518  Veal:  I 

2520  CLEAR  SCREEN 

2522  OPTION  BASE  1 

2524  DEG 

2526  KBD  CMODE  ON 

2528  PRINTER  IS  CRT 

2530  OFF  KEY 

2532  GOSUB  Init 

2534  GOSUB  Vcal_scope 

2536  GOSUB  Vcal  cont 

2538  SUBEXIT 

2540  ! 

2542  j »*«***«*G0«*'&a**«e»**«tf'e'***»***'*««'***»******'**ee»*'**'*****'*'** 

2544  ! 

2546  Vcal_scope:  ! 

2548  ! Sets  or  re-sets  the  scope  to  previously  established  values. 

2550  ! 

2552  CALL  Scope_init(Err_flg) 

2554  IF  Err_flg  THEN 

2556  Vcal_intrpt=1 

2558  Err_flg  = 0 

2560  SUBEXIT 

2562  END  IF 

2564  OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(V_aver) 
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2566  RETURN 

2568  ! 

2570  ! ** **************************** ************ 

2572  ! 

2574  Init:! 

2576  COM  /Interrupts/  INTEGER  lntr_prty 

2578  COM  /Sysjnsi/  Msijd$[20] 

2580  COM  /Sys/  Sys_id$[1 0] 

2582  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

2584  COM  /Files/  Diskdrive$(201,Filename$[14],Ms_path$[500j 

2586  COM  /Hue/  Rev_vid$[1],Enh_off$[1],Underline$m 

2588  COM  /Hue/  Red$[1],0range$[1],L_blue$[1] 

2590  COM  /Mnu/  INTEGER  lnterrupted,Which,T_which,V_which,Allowd$(*) 

2592  COM  /Mnu/  INTEGER  Stp 

2594  COM  /Scope/  REAL  Time_per_div,  Volts, Trange,Vrange,Dly 

2596  COM  /Scope/  REAL  Probe_fac,Offs,Trig,Atten 

2598  COM  /Scope/  INTEGER  Aver,Pnts,Chnnl 

2600  COM  /Scope/  Type$[301,Refer$[14],@Scope,Mode$[30] 

2602  COM  /Vcal  vals/  INTEGER  Vaver, Interval, REAL  V_step,V_min 
2604  COM  /Sleet/  INTEGER  Lastl  ,Tlast,Vlast 

2606  I 

2608  I 

2610  DIM  Version$[80J 

2612  DIM  Test$[1 60],Data_id$[40] 

2614  DIM  Choice$[1 5] 

2616  ! 

2618  I 

2620  INTEGER  Co_ords(4,4),Lwrlftx,Lwrlfty,UpperrtxtUpperrtty 

2622  INTEGER  Num_of_choices,What(1 ) 

2624  INTEGER  I, J,Pen,Knobcount, Counter 

2626  INTEGER  Error_flag,Beep_flag,Local_prty,Valid,Datacount 

2628  INTEGER  FilesizeeBaddata,Endpoint,Print_val 

2630  INTEGER  Yref,Temp,Err_flg 

2632  ! 

2634  I 

2636  REAL  Data_entered,Data_set_count 

2638  REAL  Yinc,Yor,Rtemp,Add,Waveform(32767) 

2640  Local_prty  = lntr_prty 

2642  Ftype$  = "BDAT" 

2644  Filesize  = 500 

2646  Lastl  =0 

2648  PEN  1 

2650  Beep_flag=0 

2652  Paused  = 1.5 

2654  ! 

2656  IVoltage  calibration  variables 

2658  I 

2660  ! 

2662  RETURN 

2664  I 

2666  I * *****  * * 5 * * c * * * * * * * 6 ******  * * * »**««**  * 

2668  ! 

2670  Graphs_vcl300:l 

2672  IThis  routine  fills  the  array  used  by  the  selectgraphics 

2674  {routine.  The  array  contains  the  coordinates  for  the 

2676  Irectangles  drawn  in  select  graphics. 
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2678  !if  the  data  is  all  zeros,  this  is  a null  field  and  is 

2680  lused  to  make  all  rows  of  equal  length. 

2682  (These  coordinates  are  for  the  system  300  machines. 

2684  Frst:  DATA  30,900,176,77  !1 ,1 
2686  DATA  665,900,245,77  11,2 

2688  DATA  30,675,176,77  !2,1 

2690  DATA  665,675,245,77  12,2 

2692  RESTORE  Frst 

2694  READ  Co_ords(#) 

2696  Num_of_choices  = 4 I total  number  of  on  screen  choices 
2698  Rowsize  = 2 

2700  RETURN 

2702  ! 

2704  ! 

2706  ! * * 

2708  I 

2710  Vcal_cont:  ! 

2712  ! 

2714  OFF  KEY 

2716  Vcal_intrpt=1 

2718  lntr_prty  = Local_prty  + 1 

2720  LOOP 

2722  IF  Vcal_intrpt=1  THEN 

2724  IF  Sys_id$[1 ,4]  = "S300"  THEN 

2726  CONTROL  CRT,5;1 

2728  SEPARATE  ALPHA  FROM  GRAPHICS 

2730  GOSUB  Graphs_vcl300 

2732  END  IF 

2734  END  IF 

2736  IF  (Vcal_intrpt=  1 ) OR  (Vcaljntrpt  = 3)  THEN 

2738  GOSUB  Backgrnd 

2740  GOSUB  Fill_vals 

2742  CALL  Select_graphics(V_which,Vlast,Co_ords(#)) 

2744  END  IF 

2746  IF  Vcaljntrpt  THEN  GOSUB  Vcaljnenu 

2748  Interrupted  = 1 

2750  ON  KEY  9 LABEL  "EXIT  PROG  RAM  ",Local_prty  + 3 GOTO  Retl 

2752  END  LOOP 

2754  Retl:  Stp  = 1 IThis  will  cause  the  entire  program  to  end. 

2756  Interrupted  = 0 

2758  Ret2:  OFF  KEY  IThis  will  exit  only  this  subprogram. 

2760  CLEAR  SCREEN 

2762  lntr_prty  = Local_prty 

2764  RETURN 

2766  I 

2768  i***************************************************************** 
2770  I 

2772  Vcaljnenu:  I 

2774  Vcaljntrpt  = 0 

2776  OFF  KEY 

2778  OFF  KBD 

2780  OFF  KNOB 

2782  Knobcount  = 0 

2784  DISP  Orange$;"VCAL  MENU  " 

2786  ON  KBD, Local jjrty  + 1 GOSUB  Process_kbd 
2788  ON  KNOB  .01  ,Local_prty  + 1 GOSUB  Move_pointer 
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2790  ON  KEY  1 LABEL  "ACQUIRE  DATA  ",Local_prty  + 1 GOSUB  Vcal_acq 

2792  ON  KEY  5 LABEL  "MAIN  MENU  \Local_prty  + 1 GOTO  Ret2 

2794  ON  KEY  7 LABEL  "MANUAL  SETUP", Local_prty  + 1 GOSUB  Scpjcl 

2796  SELECT  V_which 

2798  ! 

2800  CASE  1 !#  of  voltage  intervals 

2802  ON  KEY  3 LABEL  "CHANGE  VALUE", Localprty  + 1 GOSUB  Inputjntervai 

2804  ! 

2806  CASE  2 ! averages 

2808  ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  Choose_average 

2810  ! 

2812  CASE  3 Ivoltage  step 

2814  ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  lnput_step 

2816  I 

2818  CASE  4 ! minimum  calibration  voltage 

2820  ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  lnput_min_volt 

2822  ! 

2824  ! 

2826  CASE  ELSE 

2828  GOSUB  Beeps 

2830  DISP  "ERROR  PARAMETER  OUT  OF  RANGE" 

2832  WAIT  Paused 

2834  END  SELECT 

2836  I 

2838  RETURN 

2840  ! 

2842  !***** *************************************************** 

2844  ! 

2846  Process_kbd:  ! 

2848  Test$  =KBD$ 

2850  IF  LEN(Test$)  = 1 AND  Test$[1 ,1  ] < >CHR$(32)  THEN  RETURN 

2852  VcaSjntrpt  = 2 

2854  IF  Test$(1,1]=CHR$(32)  THEN 

2856  REPEAT 

2858  IF  V which < Num_of_choices  THEN 

2860  Vwhich  = V_which  + 1 

2862  ELSE 

2864  V which  =1 

2866  END  IF 

2868  UNTIL  Co_ords(V_which,  1 ) < > 0 

2870  CALL  Select_graphics(V_which,Vlast,Co_ords(*)) 

2872  END  IF 

2874  IF  Test$[1,1]<  >CHR$(255)  THEN  RETURN 

2876  SELECT  Test${2,2] 

2878  CASE  CHR$(255) 

2880  ! do  nothing,  this  is  a CTRL  character 

2882  CASE  "V\"T"  Idown  arrow 

2884  REPEAT 

2886  IF  V_which<  = (Num_of_choices-Rowsize)  THEN 

2888  V_which  = V_which  + Rowsize 

2890  ELSE 

2892  V_which  = Rowsize-(Num_of_choices-V  which) 

2894  END  IF 

2896  UNTIL  Co „ords(V j/vhich,  1 ) < > 0 

2898  CASE  "A","W"  !up  arrow 

2900  REPEAT 
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2902 

2904 

2906 

2908 

2910 

2912 

2914 

2916 

2918 

2920 

2922 

2924 

2926 

2928 

2930 

2932 

2934 

2936 

2938 

2940 

2942 

2944 

2946 

2948 

2950 

2952 

2954 

2956  ! 

2958  !** 

2960  ! 


IF  V_which>Rowsize  THEN 
V_which  = V_which-Rowsize 
ELSE 

V_which  = V_which  + (Num_of_choices-Rowsize) 
END  IF 

UNTIL  Co_ords(V_which,1)<  >0 
CASE  lleft  arrow,  prev  key 

REPEAT 

IF  V_which  > 1 THEN 
V_which  = V_which-1 
ELSE 

V_which  = Num_of_choices 
END  IF 

UNTIL  Co_ords(V_which,1)<  >0 
CASE  Iright  arrow,  next  key 

REPEAT 

IF  V_which<Num_of_choices  THEN 
Vwhich  = V_which  + 1 
ELSE 

V_which  = 1 
END  IF 

UNTIL  Co_ords(V_which,1 ) < >0 
CASE  ELSE  " 

BEEP  80.,. 1 
END  SELECT 

CALL  Select_graphics(V_which, Vlast,Co_ords( * )) 
RETURN 


##***•******•***•**********•*#•**************«****#*****£•***«* 


2962  Move_pointer:  I 


2964 

2966 

2968 

2970 

2972 

2974 

2976 

2978 

2980 

2982 

2984 

2986 

2988 

2990 

2992 

2994  ! 

2996  !* * 

2998  ! 


Knobcount  = Knobcount  + KNOBX-KNOBY 
IF  ABS(Knobcount)  < 1 5 THEN  RETURN 
Veal  Jntrpt  = 2 
REPEAT 

IF  Knobcount  >0  THEN 
V^which  = V_which  + 1 
ELSE 

V_which  = V_which-1 
END  IF 

IF  V_which<1  THEN  V_which  = Num_of_choices 
IF  V_which  > Num_of_choices  THEN  V_which  = 1 
UNTIL  Co_ords(V_which,1 ) < >0 
CALL  Seiect_graphics(V_which,  Vlast,Co_ords(  * )) 
Knobcount  = 0 
RETURN 


#*###**######*#*****#*###*#**#****##*#######*#**###*#***#*##** 


* 


3000  Backgrnd:  ! 

3002  ! 

3004  CLEAR  SCREEN 

3006  IF  Sys Jd $ [ 1 ,4]  = "S300"  THEN 

3008  MERGE  ALPHA  WITH  GRAPHICSIThis  gives  back  the  colors  to  the  alpha 

3010  Iplane. 

3012  END  IF 
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3014  PRINT  TABXY(1,1);Rev_vid$;L_blue$;"  it  OF  VOLTAGE  ";Enh_off$; 

3016  PRINT  TABXY(1 ,2);Rev_vid$;L_blue$;"  INTERVALS  ";Enh_off$ 

3018  PRINT  TABXY(1,7);Rev_vid$;L_blue$;"  VOLTAGE  STEP  ";Enh_off$; 

3020  PRINT  TABXY(1,8);Rev_vid$;L_b!ue$;"  SIZE  (VOLTS)  ";Enh_off$; 

3022  PRINT  TABXY(55,1  );Rev_vid$;L_blue$;"  NUMBER  OF  ";Enh_off$; 

3024  PRINT  TABXY(55,2);Rev_vid$;L_blue$;"  AVERAGES  ";Enh_off$; 

3026  PRINT  TABXY(55f7);Rev_vid$;L_blue$;"  MINIMUM  CALIBRATION  ";Enhjjff$; 

3028  PRINT  TABXY(55,8);Rev_vid$;L_blue$;"  VOLTAGE  (VOLTS)  ";Enh_off$; 

3030  RETURN 

3032  ! 

0Q24  i##*#########*#######*#*#*#*#*####****##*###*#*#*###***********#** 

3036  ! 


3038  Fill_vals:  ! 

3040  GOSUB  Print_ave 

3042  GOSUB  Printintervls 

3044  GOSUB  Print_step 

3046  GOSUB  Print_min_ca! 

3048  RETURN 

3060  ! 


3054  ! 


3056  Scpjcl:  I 


3058 

3060 

3062 

3064 

3066 

3068 

3070 

3072 

3074 

3076 

3078 

3080 

3082 

3084 

3086 

3088 

3090 

3092 

3094 

3096 

3098 

3100 

3102 

3104 

3106 

3108 

3110 

3112 

3114 

3116  ! 

3118  ! 

3120  ! 


Ithis  allows  the  operator  to  manually  set  up  the  scope. 

! 

OFF  KBD 
OFF  KEY 
OFF  KNOB 
Vcaljntrpt  = 3 
CLEAR  SCREEN 

PRINT  TABXY(IJ);"  This  is  to  establish  the  number  of  voltage  " 
PRINT  " intervals  needed  and  the  minimum  voltage  level  required  " 
PRINT  " for  calibrating  the  voltage  levels  of  the  oscilloscope.  " 

PRINT  " Any  changes  made  to  the  scope  settings  will  be  re-set  to  " 
PRINT  " the  values  which  were  present  before  this  option  was  " 

PRINT  " invoked.  If  changes  are  required,  please  use  either  the  " 

PRINT  " waveform  acquisition  menu  or  the  voltage  calibration  menu.  " 
PRINT  " Voltage  calibration  data  is  not  valid  for  a DUT  waveform  " 
PRINT  " which  has  a different  sensitivity  and/or  offset." 

I 

PRINT  TABXYO  ,21  );"The  current  channel  is  ",Chnnl 
INPUT  "is  this  the  correct  channel  ? Y/N  ",Ch$ 

IF  (Ch$  = "n")  OR  (Ch$  = "N")  THEN  GOSUB  Get_chn 
CLEAR  SCREEN 
! 

PRINT  TABXY(1 ,24);"Please  set  up  the  waveform  and 
PRINT  "press  continue  when  done." 

LOCAL  707 
CALL  Pause_key_on 
OFF  KEY 

GOSUB  Vcal_scope 
RETURN 


* * 


* * 


3122  Chnl_err:  \ 
3124  BEEP 
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3126  DISP  "Input  out  of  range  or  disallowed  value." 
3128  WAIT  Paused 

3130  DISP  "Try  again  ..." 


3132  Get_chn:  I 

3134  ON  ERROR  GOTO  Chnl_err 

3136  Test$  = "" 

3138  INPUT  "Enter  the  acquisition  channel  number  (1-4).",Test$ 

3140  IF  LEN(Test$)<  1 THEN  RETURN 

3142  Temp  = VAL(Test$) 

3144  OFF  ERROR 

3146  IF  (Temp  < 1 ) OR  (Temp  > 4)  THEN  GOTO  Chnnl_error 

3148  OUTPUT  @Scope;"BLANK  CHANNEL" &VAL$(Chnnl) 

3150  Chnnl=Temp 

3152  OUTPUT  @Scope;"VIEW  CHANNEL" &VAL$(Chnnl) 

3154  1 The  number  of  point  can  only  be  changed  from  the  controller. 

3156  RETURN 

3158  I 

3 1 60  j***************************************^******************************** 
3162  ! 

3164  ! 

3166  ! ============================================= 

3168  I = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 
3170  I Data  input  subroutines 

3172  ! ============================================= 

3174  ! ============================================= 

3176  ! 

3178  i********************************************'11'******************** 

3180  ! 


31 82  Choose_average:  I 

3184  OFF  KEY 

3186  OFF  KNOB 

3188  OFF  KBD 

3190  CLEAR  SCREEN 

3192  GCLEAR 

3194  PRINT  L_blue$ 

3196  DIM  Dp$[80] 

3198  DIM  T$[52] 

3200  Dp$  = "Select  Average  " 

3202  T$  = " Available  Averages  (powers  of  2 ) 

3204  lntr_prty  = lntr_prty + 3 

3206  CALL  Menu_scroll(Dp$,T$,Allowd$(#  ),1 2, 1 ,What(*)) 

3208  lntr_prty  = lntr_prty-3 

3210  IF  What(1)<>0  THEN  I Aborted 

321 2 V_aver  = VAL(Allowd$(What(1 ))) 

3214  END  IF 

3216  Vcal_intrpt  = 3 

3218  ! 

3220  OUTPUT  @Scope;":ACQUIRE:TYPE  AVERAGE" 

3222  OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(V_aver) 

3224  RETURN 

3226  Print_ave:  I 

3228  PRINT  TABXY(60,4);Orange$; 

3230  CALL  Auto_format(V_aver*  1 .0) 

3232  RETURN 

3234  ! 

3236  ! 
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3238  !»**#*##*###*##**#***#********»#***#»##*#**#*»************»******* 
3240  ! 

3242  lntervaI_error:  ! 

3244  GOSUB  Beeps 

3246  DISP  "ERROR  IN  READING  VALUE  OR  DISALLOWED  VALUE,  TRY  AGAIN." 

3248  WAIT  Paused 

3250  Inputjnterval:  I 

3252  ON  ERROR  GOTO  lnterval_error 

3254  Test$  ="" 

3256  INPUT  "Enter  the  number  of  voltage  intervals.", Test  $ 

3258  IF  LEN(Test$)  < 1 THEN  RETURN 

3260  Temp  = VAL(Test$) 

3262  OFF  ERROR 

3264  IF  Temp<1  THEN  GOTO  Intervalerror 

3266  Interval  =Temp 

3268  Printjntervls:  ! 

3270  PRINT  TABXY(2,4);Orange$; 

3272  CALL  Auto  formatdnterval  *1.0) 

3274  IF  NOT  (VcaMntrpt)  THEN  CALL  Select_graphics(V_which,Vlast,Co_ords(*)) 

3276  RETURN 

3278  ! 

3282  I 

3284  Step  error:  I 
3286  GOSUB  Beeps 

3288  DISP  "ERROR  IN  READING  VALUE  OR  VALUE  OUT  OF  RANGE.  TRY  AGAIN." 

3290  WAIT  Paused 

3292  lnput_step:  ! 

3294  ON  ERROR  GOTO  Step^error 

3296  Test$  = "" 

3298  DISP  "Enter  the  voltage  step  size." 

3300  INPUT  "This  must  be  a positive,  real  number.",Test$ 

3302  IF  LEN(Test$)  < 1 THEN  RETURN 

3304  GOSUB  Datacheck 

3306  OFF  ERROR  " 

3308  IF  Rtemp<0.  THEN  GOTO  Step_error 

3310  Vstep  = Rtemp 

331 2 Print_step:  ! 

3314  PRINT  TABXY(1,1 0);0range$; 

3316  CALL  Autoformat(Vstep) 

3318  IF  NOT  (VcaMntrpt)  THEN  CALL  Select_graphics(V_which,Vlast,Co_ords(*)) 

3320  RETURN 

3322  ! 

3324  j***'s®'e'*®'9*®4'c's'e'®*®c®#**®®®'e***',!'*#**',,'*##*,***'*#'**#***',#************ 
3326  I 

3328  Minvolt_error:  I 
3330  GOSUB  Beeps 

3332  DISP  "ERROR  IN  READING  VALUE  OR  VALUE  OUT  OF  RANGE.  TRY  AGAIN." 

3334  WAIT  Paused 

3336  Input_min_volt:  ! 

3338  ON  ERROR  GOTO  Minvolt_error 

3340  Test$  ="" 

3342  INPUT  "Enter  the  minimum  calibration  voltage. ",Test$ 

3344  IF  LEN(Test$)  < 1 THEN  RETURN 

3346  GOSUB  Datajsheck 

3348  OFF  ERROR  ‘ 
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3350  V_min  = Rtemp 

3352  Print_min_cal:  ! 

3354  PRINT  TABXY(59,10);Orange$; 

3356  CALL  Auto_format(V_min) 

3358  IF  NOT  (VcaIJntrpt)  THEN  CALL  Select_graphics(V_which,Vlast,Co_ords(*)) 

3360  RETURN 

3362  ! 

3364  # *****  * * * * * * * * * * * * * 

3366  ! 

3368  Vcal_acq:  I 

3370  ALLOCATE  Vcal_ary((lnterval  + 2), 2) 

3372  ! Vcal_ary(1 ,1 ) = # of  voltage  levels  measured. 

3374  ! Vcal_ary(i,1 ) = the  measured  voltage.  i = 2 to  interval + 2 

3376  ! Vcal_ary(i,2)  = the  calibration  voltage. 

3378  Counter  = 2 

3380  V_true  = Vjnin 

3382  Kill_meas  = 0 

3384  Vcal_ary(1 ,1  ) = Interval  + 1 

3386  OFF  KEY 

3388  OFF  KNOB 

3390  OFF  KBD 

3392  WHILE  NOT  (Kill_meas)  AND  (Counter  < = (Interval  + 2)) 

3394  ON  KEY  0 LABEL  " ABORT  ",Local_prty  + 5 GOTO  Abort_vmeas 

3396  BEEP 

3398  DISP  "Set  input  voltage  to";V_true;"  press  continue  when  ready." 

3400  PAUSE 

3402  GOSUB  Get_vwave 

3404  IF  NOT  (Killjneas)  THEN 

3406  GOSUB  Con_to_volts 

3408  Add  = 0 

3410  FOR  J = 1 TO  Pnts 

3412  Add  = Add  + Voltage(J,2) 

3414  NEXT  J 

3416  Add  = Add/Pnts 

3418  !add  is  the  average  dc  voltage  measured. 

3420  Vcal_ary  (Counter,  1 ) = Add 

3422  Vcal_ary  (Counter,  2)  = Vtrue 

3424  V_true  = Vjrue  + Vstep 

3426  Counter  = Counter  + 1 

3428  DEALLOCATE  VoltageD 

3430  END  IF 

3432  END  WHILE 

3434  IF  NOT  (Killjneas)  THEN 

3436  OFF  KEY 

3438  CLEAR  SCREEN 

3440  PRINT  TABXY(1 ,1  );"There  were  ";Vcal_ary(1 ,1 );"  levels  measured." 

3442  PRINT  TABXY(1,3);"MEASURED  VOLTAGE"; 

3444  PRINT  TABXY(30,3);"CALIBRATION  VOLTAGE"; 

3446  FOR  1 = 2 TO  Vcal_ary(1 ,1 ) + 1 

3448  PRINT  TABXY(2,I  + 3);Vcal_ary (1, 1 ); 

3450  PRINT  TABXY(32,I  + 3);Vcal_ary(l,2); 

3452  NEXT  I 

3454  INPUT  "Is  the  data  Okay?  y/n",Ch$ 

3456  IF  Ch$  = "n"  OR  Ch$="N"  THEN 

3458  DISP  "Please  re-set  the  measurement  and  try  again." 

3460  WAIT  1.5 
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3462  ELSE 

3464  INPUT  "Enter  data  description,  40  chrs  or  less.  ",Data_id$ 

3466  lntr_prty  = Localprty  + 1 

3468  CALL  Data_to_diskj(1  ,INT({Counter  + 1 )),Vcal_ary(*),DataJd$) 

3470  lntr_prty  = Local_prty 

3472  END  IF 

3474  END  IF 

3476  DEALLOCATE  Vcal_ary(*) 

3478  OFF  KEY 

3480  Vcal_jntrpt  = 3 

3482  RETURN 

3484  ! 

3486  !***••** * * * * * * 

3488  ! 

3490  Abort_vmeas:  ! 

3492  CLEAR  @Scope 

3494  LOCAL  @Scope 

3496  Kii!_meas  = 1 

3498  CLEAR  SCREEN 

3500  DISP  Red $;" MEASUREMENT  ABORTED"  ;Enh_off$ 

3502  OFF  KEY 

3504  OFF  KNOB 

3506  OFF  KBD 

3508  OFF  ERROR 

3510  VcaMntrpt  = 3 

3512  GOTO  Vcal  scope 

3514  ! 

3516  i*********************®®**********®**®***************************®** 
351 8 Data  error:  I 

3520  BEEP 

3522  DISP  "ERROR  IN  READING  SCOPE.  WILL  TRY  AGAIN" 

3524  WAIT  Paused 

3526  Get  vwave:  ! 

3528  Do_meas  = 0 

3530  IF  NOT  |Kill_meas)  THEN 

3532  ON  ERROR  GOTO  Data_error 

3534  OUTPUT  @Scope;B *CLS" 

3536  WAIT  1 

3538  OUTPUT  @Scope;":TER?" 

3540  ENTER  @Scope;Ter$ 

3542  IF  (VAL(Ter$)  < > 1 ) THEN 

3544  GOSUB  Beeps 

3546  DISP  "No  signal  detected;  please  check  the  setup." 

3548  WAIT  2 

3550  CLEAR  SCREEN 

3552  OFF  KEY 

3554  OFF  KNOB 

3556  OFF  KBD 

3558  OFF  ERROR 

3560  CALL  Scopejnit(ErrJlg) 

3562  IF  Err  flg  THEN  interrupted  = 1 

3564  Vca!_intrpt  = 3 

3566  SUBEXIT 

3568  END  IF 

3570  DISP  "System  busy;  Measurement  Number" .Counter- 1 ;"of";lnterval  + 1 

3572  OUTPUT  @Scope;":TIMEBASE:DELAY  "&VAL$«Dly) 
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3574 

3576 

3578 

3580 

3582 

3584 

3586 

3588 

3590 

3592 

3594 

3596 

3598 

3600 

3602 

3604 

3606 

3608 

3610 

3612 

3614 

3616 

3618 

3620 

3622 

3624 

3626 

3628 

3630 

3632 

3634 

3636 

3638 

3640 

3642 

3644 

3646 

3648 

3650 

3652 

3654 

3656 

3658 

3660 

3662 

3664 

3666 

3668 

3670 

3672 

3674 

3676 

3678 

3680 

3682 

3684 


OUTPUT  @Scope;":TIMEBASE:RANGE  "&VAL$(Trange) 

OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":OFFSET  "&VAL$(Offs) 

OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":RANGE  "&VAL$(Vrange) 

OUTPUT  @Scope;":ACQUIRE:TYPE  AVERAGE" 

OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(V_aver) 

OUTPUT  @Scope;":ACQUIRE:POINTS  "&VAL$(Pnts) 

OUTPUT  @Scope;"*CLS" 

OUTPUT  @Scope;"*SRE  32;*ESE  1" 

OUTPUT  @Scope;":DIGITIZE  CHAN"&VAL$(Chnnl)&";#OPC" 

! Digitizes  the  channel  and  asks  for  the  operation  complete 
! status  indicator  flag. 

I 

I This  loop  enables  the  keyboard  interrupt  key  called  ABORT. 

! The  abort  key  will  work  even  when  the  scope  is  busy. 

! 

WHILE  NOT  BIT(Stat,5) 

Stat  = SPOLL(@Scope) 

END  WHILE 

OUTPUT  @Scope;":SYSTEM:HEADER  OFF;:EOI  ON" 

OUTPUT  @Scope,°"  WAVEFORM:  SOURCE  WMEMORY"&VAL$(Chnnl)&";  FORMAT  WORD" 
OUTPUT  @Scope;"WAVEFORM:DATA?" 

ENTER  @Scope  USING  "#,A,D";Header$, Bytes 
IF  Bytes  = 3 THEN 

ENTER  @Scope  USING  "#,3D" .Length 
END  IF 

IF  Bytes  = 4 THEN 

ENTER  @Scope  USING  "#,4D";Length 
END  IF 

Length  = Length/2 
IF  Pnts<  > Length  THEN 

DISP  "The  scope  will  not  allow  ", Pnts, "points." 

WAIT  Paused 

DISP  "The  number  of  points  is  now  ".Length,"." 

WAIT  Paused 
Pnts  = Length 
END  IF 

REDIM  Waveform(Length) 

ENTER  @Scope  USING  "#,W";Waveform(#) 

ENTER  @Scope  USING  "-K,B";End$ 

OUTPUT  @Scope;": WAVEFORM: YINCREMENT?" 

ENTER  @Scope;Yinc 

OUTPUT  @Scope;":WAVEFORM:YORIGIN?" 

ENTER  @Scope;Yorg 

OUTPUT  @Scope;" : WAVEFORM:YREFERENCE?" 

ENTER  @Scope;Yref 

OUTPUT  @Scope;":WAVEFORM:XINCREMENT?" 

ENTER  @Scope;Xinc 

OUTPUT  @Scope;":WAVEFORM:XORIGIN?" 

ENTER  @Scope;Xorg 

OUTPUT  @Scope;":WAVEFORM:XREFERENCE?" 

ENTER  @Scope;Tref 
OFF  ERROR 
IF  Bugl  THEN 

FOR  I = 1 TO  Pnts 
PRINT  Waveform(l) 

NEXT  I 


B33 


3686  END  IF 

3688  END  IF 

3690  RETURN 

3692  I 

3694  !********•****•*******•**•*•******•*********•*•*************•***** 
3696  I 

3698  Contovolts:  I 

3700  ALLOCATE  Voltage(Pnts,2) 

3702  FOR  I = 1 TO  Pnts 

3704  Voltage(lf2)  = ((Waveform(l)-Yref)#  Yinc)  + Yorg 

3706  Voltaged,  1 ) = ((1-1 ) * Xinc) 

3708  NEXT  I 

3710  RETURN 

3712  ! 

3714  \*  ****** * #**.«*..***#.##.**»»*****#*.*#*****».***«*#* 

3716  ! 

3718  Data_check:  S 

3720  I The  following  is  a test  of  the  lower  case  e in  a number  of 

3722  ! scientific  notation.  If  a lower  case  e occurs,  it  is  converted 

3724  I to  upper  case.  That  is  all. 

3726  IF  POS(Test$,"e")  THEN 

3728  Temp  = POS(Test$,"e") 

3730  Test$[Templ  = "EK&Test$[Temp  + 1 ,LEN(Test$)l 

3732  END  IF 

3734  I end  of  lower  case  conversion 

3736  Rtemp  = VAL(Test$) 

3738  RETURN 

3740  ! 

3742  i***********************#*®*************#®******®®®®*********®®®®***®* 
3744  ! 

3746  Beeps:  ! 

3748  BEEP  400,. 25 

3750  BEEP  600,. 50 

3752  BEEP  400, .25 

3754  RETURN 

3756  ! 

3758  SUBEND 
3760  ! 

3764  I 

3766  SUB  Teal 
3768  Teal:  I 

3770  CLEAR  SCREEN 

3772  OPTION  BASE  1 

3774  KBD  CMODE  ON 

3776  PRINTER  IS  CRT 

3778  OFF  KEY 

3780  GOSUB  Tcal_vars 

3782  GOSUB  Tcal  scope 

3784  GOSUB  Tcai_cont 

3786  SUBEXIT 

3788  I 

3790  | * * * * * * * * * * * * * * * * • * * * * * * • * * • * * * * • * * * * « • 4 * 4 5 * * * 4 * * * * * * * # * * * * 4 * 

3792  ! 

3794  Tcal  vars:! 

3796  COM  /Interrupts/  INTEGER  lntr_prty 


B34 


3798  COM  /Sys_msi/  Msi_id$[20] 

3800  COM  /Sys/  Sys_id$[10] 

3802  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

3804  COM  /Files/  Diskdrive$l20],Filename${14],Ms_path$[500] 

3806  COM  /Hue/  Rev_vid$[1],Enh_off$[1],Underline$[1] 

3808  COM  /Hue/  Red$[1],0range$[1],L_blue$[1] 

3810  COM  /Mnu/  INTEGER  lnterrupted,Which,T_which,V_which,Allowd$(#) 

3812  COM /Mnu/ INTEGER  Stp 

3814  COM  /Scope/  REAL  Time_per_div, Volts, Trange,Vrange,Dly 

3816  COM  /Scope/  REAL  Probe_fac, Offs, Trig, Atten 

3818  COM  /Scope/  INTEGER  Aver,Pnts,Chnnl 

3820  COM  /Scope/  Type$[30],Refer$[14],@Scope,Mode$[30] 

3822  COM  /Tcal_vals/  INTEGER  Zero_x,Ls_prs, Slope, T_aver, REAL  Freq 

3824  COM  /Tcal_vals/  Slpe$[10],Save$[10],REAL  Tc_off,Tc_volt,T_trig 

3826  COM  /Line_fit/  INTEGER  Wav(1 024) 

3828  COM  /Sleet/  INTEGER  Lastl  ,Tlast,Vlast 

3830  ! 

3832  I 

3834  DIM  Version$[80] 

3836  DIM  Test$(1 60],Data_id$[40] 

3838  DIM  Choice$[1 5] 

3840  ! 

3842  ! 

3844  INTEGER  Co_ords(9,4),Lwrlftx,Lwrlfty,Upperrtx,Upperrtty 

3846  INTEGER  Num_of_choices,What(1 ) 

3848  INTEGER  l,Cntr,Pen,Knobcount 

3850  INTEGER  Error_flag,Beep_flag,Local_prty, Valid, Datacount 

3852  INTEGER  Filesize,Baddata, Endpoint, Print_val 

3854  INTEGER  Yref,Temp,Tcal_intrpt,Kount 

3856  INTEGER  Strt,End_pnt,Midval,Err_flg 

3858  ! 

3860  ! 

3862  REAL  Data_entered,Data_set_count 

3864  REAL  Yinc,Yor,Rtemp,Zero_level,Ln_slp,lntrcpt 

3866  REAL  Maxval,Minval,Waveform(32767) 

3868  ! 

3870  ! 

3872  Local_prty  = lntr_prty 

3874  Ftype$  = "BOAT" 

3876  Filesize  = 32767 

3878  Lastl  =0 

3880  PEN  1 

3882  Beep_flag=0 

3884  Paused  = 1.5 

3886  ! 

3888  ITime  calibration  variables 

3890  I 

3892  ! 

3894  RETURN 

3896  ! 

3898  i*****************************’************************************ 
3900  ! 

3902  Tcal_scope:  I 

3904  CALL  Scope_init(Err_flg) 

3906  IF  Err_flg  THEN 

3908  Tcal_intrpt  = 3 
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3910  Err_f  Ig  = 0 

3912  SUBEXIT 

3914  END  IF 

3916  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":OFFSET  "&VAl$(Tc_off) 

3918  Tc_vrange  =Tc_volt*8 

3920  OUTPUT  @Scope;^CHANNEL"&VAL$(Chnnl)&":RANGE  "&VAL$(Tc_vrange) 

3922  OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(T_aver) 

3924  OUTPUT  @Scope;"TRIGGER:LEVEL  "&VAL$(T_trig) 

3926  RETURN 

3928  ! 

3930  ! 

3932  !***** *************** *********************** 

3934  ! 

3936  ! 


3938 

3940 

3942 

3944 

3946 

3948 

3950 

3952 

3954 

3956 

3958 

3960 

3962 

3964 

3966 

3968 

3970 

3972 

3974 

3976 

3978 

3980 

3982 

3984 

3986 


Graphs_ary300:l 

IThis  routine  fills  the  array  used  by  the  selectjjraphics 
[routine.  The  array  contains  the  coordinates  for  the 
Irectangles  drawn  in  select_graphics. 

!«f  the  data  is  all  zeros,  this  is  a null  field  and  is 
fused  to  make  all  rows  of  equal  length. 

IThese  coordinates  are  for  the  system  300  machines. 
First:DATA  30,943,1 76,34  11,1  frequency 

DATA  372,943,245,34  !1,2  save  the  waveform 
DATA  714,943,220,34  ! 1 ,3  averages 
DATA  30,830,176,35  !2,1  volts 

DATA  372,830,245,35  !2,2  calibrate  on  (pos/neg  slope) 

DATA  714,793,220,70  !2,3  number  of  points  for  the  moving  average 
DATA  30,717,176,35  ! 3,1  offset  mv 

DATA  372,680,245,70  !3,2  number  of  least  squares  point  pairs 
DATA  714,680,220,35  !3,3  trigger  level  for  time  calibration 
RESTORE  First 
READ  Co_ords(*) 

Numofchoices  = 9 f total  number  of  on  screen  choices 

Rowsize  = 3 

RETURN 


I # # 3 * O 


3988  Tcai_cont:  ! 

3990  ! 

3992  OFF  KEY 

3994  Tcal_intrpt=1 

3996  LOOP 

3998  IF  Tcal_intrpt=1  THEN 

4000  IF  Sys_id$[1 ,4]  = "S300"  THEN 

4002  CONTROL  CRT,5;1 

4004  SEPARATE  ALPHA  FROM  GRAPHICS 

4006  GOSUB  Graphs_ary300 

4008  END  IF 

4010  END  IF 

4012  IF  fTcalJntrpt  = 1 ) OR  (Tcaljntrpt  = 3)  THEN 

4014  GOSUB  Background 

4016  GOSUB  Fill  in 

4018  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4020  END  IF 
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4022  IF  TcaIJntrpt  THEN  GOSUB  Tcal_menu 

4024  Interrupted  = 1 

4026  ON  KEY  9 LABEL  "EXIT  PROGRAM", Local_prtY  + 2 GOTO  Retl 

4028  END  LOOP 

4030  Retl:  Stp  = 1 IThis  will  cause  the  entire  program  to  end. 

4032  Ret2:  OFF  KEY  IThis  will  exit  only  this  subprogram. 

4034  CLEAR  SCREEN 

4036  RETURN 

4038  ! 

4040  !# * **.*«.***«.###*. 

4042  ! 


4044 

4046 

4048 

4050 

4052 

4054 

4056 

4058 

4060 

4062 

4064 

4066 

4068 

4070 

4072 

4074 

4076 

4078 

4080 

4082 

4084 

4086 

4088 

4090 

4092 

4094 

4096 

4098 

4100 

4102 

4104 

4106 

4108 

4110 

4112 

4114 

4116 

4118 

4120 

4122 

4124 

4126 

4128 

4130 

4132 


Tcal_menu:  I 

TcaIJntrpt  = 0 
OFF  KEY 
OFF  KBD 
OFF  KNOB 
Knobcount  = 0 

DISP  Orange$;"TCAL  MENU  " 

ON  KBD,Local_prty  + 1 GOSUB  Process_kbd 
ON  KNOB  .01,Local_prty  + 1 GOSUB  Move_pointer 
ON  KEY  1 LABEL  "ACQUIRE  DATA  ",Local_prty  + 1 GOSUB  Tcal  data 
ON  KEY  5 LABEL  "MAIN  MENU  ",Local_prty  + 1 GOTO  Ret2 
ON  KEY  7 LABEL  "MANUAL  SETUP", Local_prty  + 1 GOSUB  Tcal_set 
SELECT  T_which 
I 

CASE  1 Ifrequency 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  lnput_freq 
CASE  2 Isave  the  sinewave? 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  Save_wave 
I 

CASE  3 I ft  of  point  pairs 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  Choose_average 
I 

CASE  4 ! voltage 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  lnput_volts 
! 

CASE  5 ! slope 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  Which_slope 

! 

CASE  6 I points  for  moving  average 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  Moving_points 

! 

CASE  7 ! offset 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  lnput_offset 
I 

CASE  8 ! least  squares  point  pairs 

ON  KEY  3 LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  Point_pairs 
I 

CASE  9 ! trigger  level 

ON  KEY  3, LABEL  "CHANGE  VALUE", Local_prty  + 1 GOSUB  Triggerjvl 
! 

CASE  ELSE 
GOSUB  Beeps 

DISP  "ERROR  PARAMETER  OUT  OF  RANGE" 

WAIT  Paused 
END  SELECT 
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! 

RETURN 


4134 
4136 
4138  ! 
4140  ! 
4142  ! 


4144  Process_kbd:  ! 

4146  Test$=KBD$ 

4148  IF  LEN(Test$)  = 1 AND  Test$[1 ,1]  < >CHR$(32)  THEN  RETURN 

4150  Tcaljntrpt  = 2 

4152  IF  Test$[1f1]=CHR$(32)  THEN 

4154  REPEAT 

4156  IF  Twhich  < Num_of_choices  THEN 

4158  T which  = T_which  + 1 

4160  ELSE 

4162  Twhich  = 1 

4164  END  IF 

4166  UNTIL  Co_ords(T_which,  1 ) < > 0 

4168  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4170  END  IF 

4172  IF  Test$[1 ,1 J < >CHR$(255)  THEN  RETURN 

4174  SELECT  Test$ [2,2] 

4176  CASE  CHR$(255) 

4178  ! do  nothing,  this  is  a CTRL  character 

4180  CASE  "WT"  Idown  arrow 

4182  REPEAT 

4184  IF  T_which<  = (Num  of  choices  Rowsize)  THEN 

4186  Twhich  =T_which  + Rowsize 

4188  ELSE 

4 1 90  Twhich  = Rowsize-(Num_of_choices-T_which) 

4192  END  IF 

4194  UNTIL  Co_ords(T_which,  1 ) < > 0 

4196  CASE  !up  arrow 

4198  REPEAT 

4200  IF  T which  > Rowsize  THEN 

4202  Twhich  =T_which-Rowsize 

4204  ELSE 

4206  Twhich  = Twhich  + (Num_of_choices-Rowsize) 

4208  END  IF 


42 1 0 UNTIL  Co_ords(T_which,  1 ) < > 0 

4212  CASE  "<VHV'"  Heft  arrow,  prev  key 

4214  REPEAT 

4216  IF  T which  >1  THEN 

4218  Twhich  =T_which-1 

4220  ELSE 

4222  Twhich  = Numofchoices 

4224  END  IF 

4226  UNTIL  Co  jDrds(T_which,  1 ) < > 0 

4228  CASE  ">\"G",V  fright  arrow,  next  key 

4230  REPEAT 

4232  , IF  T which  < Num  of  choices  THEN 

4234  T_which  =Tjwhich  + 1 

4236  ELSE 

4238  Twhich  = 1 

4240  END  IF 

4242  UNTIL  Co„ords(T  which,  1 ) < > 0 

4244  CASE  ELSE  " 
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4246  BEEP  80.,. 1 

4248  END  SELECT 

4250  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4252  RETURN 

4254  ! 

4256  ! ***************** ************************* 

4258  ! 

4260  Move_pointer:  ! 

4262  Knobcount  = Knobcount  + KNOBX-KNOBY 

4264  IF  ABS(Knobcount)  < 1 5 THEN  RETURN 

4266  Tcal_intrpt  = 2 

4268  REPEAT 

4270  IF  Knobcount  >0  THEN 

4272  T_which  =T_which  + 1 

4274  ELSE 

4276  T_which  = T_which-1 

4278  END  IF 

4280  IFT_which<1  THEN  T_which  = Num_of_choices 

4282  IF  T_which>Num_of_choices  THEN  T_which  = 1 

4284  UNTIL  Co_ords(T_which,1 ) < >0 

4286  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4288  Knobcount  = 0 

4290  RETURN 

4292  ! 

4294  !**######****#*#**#*###***#*****###****##*#***#*#***************** 
4296  ! 

4298  Background:  ! 

4300  ! 

4302  CLEAR  SCREEN 

4304  IF  Sysjd $ [ 1 ,4]  = "S300"  THEN 

4306  MERGE  ALPHA  WITH  GRAPHICSIThis  gives  back  the  colors  to  the  alpha 

4308  Iplane. 

4310  END  IF 

4312  PRINT  TABXY{1 ,1  );Rev_vid$;L_blue$;"  FREQUENCY  ";Enh_off$; 

4314  PRINT  TABXYO  ,4);Rev_vid$;L_blue$;"  VOLTS/DIV  (v)  ";Enh_off$; 

4316  PRINT  TABXY(1 ,7);Rev_vid$;L_blue$;"  OFFSET  (v)  ";Enh_off$; 

4318  PRINT  TABXY(30,1  );Rev_vid$;L_blue$;"  SAVE  THE  WAVEFORM  ? ";Enh_off$; 

4320  PRINT  TABXY(30,4);Rev_vid$;L_blue$;"  CALIBRATE  ON  ";Enh_off$; 

4322  PRINT  TABXY(30,7);Rev_vid$;L_blue$;"  POINT  PAIRS  FOR  ";Enh_off$; 

4324  PRINT  TABXY(30,8);Rev_vid$;L_blue$;"  LEAST  SQUARES  FIT  ";Enh_off$; 

4326  PRINT  TABXY(59,1  );Rev_vid$;L_blue$;"  # OF  AVERAGES  ";Enh_off$; 

4328  PRINT  TABXY(59,4);Rev_vid$;L_blue$;"  POINTS  TO  USE  FOR  ";Enh_off$; 

4330  PRINT  TABXY(59,5);Rev_vid$;L_blue$;'5  MOVING  AVERAGE  ";Enh_off$; 

4332  PRINT  TABXY(59(8);Rev_vid$;L_blue$;"  TRIGGER  LEVEL  ";Enh_off$; 

4334  RETURN 

4336  ! 

4338  i***************************************************************** 
4340  ! 

4342  FilIJn:  1 

4344  GOSUB  Print_volts 

4346  GOSUB  Print_offset 

4348  GOSUB  Printjreq 

4350  GOSUB  Print_save 

4352  GOSUB  Print_slope 

4354  GOSUB  Print_pairs 

4356  GOSUB  Print_sld_ave 
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4358  GOSUB  Printave 

4360  GOSUB  Print_trig_lev 

4362  RETURN 

4364  ! 

4366  i***************************************************************** 
4368  ! 

4370  ! 

4372  ! ======================================== 

4374  | = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 

4376  ! Data  input  subroutines  12/12/89 

4378  ! ======================================== 

4380  ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 

4382  ! 

4384  |ftitfffffff4fffff#ftftffft#fffffffftfffffftfffffft##fttffffftf*#fff 
4386  ! 

4388  Tcal_set:  ! 

4390  Ithis  allows  the  operator  to  manually  set  up  the  scope. 

4392  OFF  KEY 

4394  OFF  KBD 

4396  OFF  KNOB 

4398  Tcaljntrpt  = 3 

4400  CLEAR  SCREEN 

4402  PRINT  TABXYOJ);"  This  is  to  establish  the  delay  of  the  time  " 

4404  PRINT  ” signal  only.  Any  other  desired  changes  will  have  to  be  " 

4406  PRINT  " accomplished  using  the  waveform  or  teal  menus.  Use  a " 

4408  PRINT  " variable  delay  line  to  set  the  waveform  to  the  desired  " 

4410  PRINT  " position.  If  the  delay  is  set  using  the  DELAY  key  of  the  " 

4412  PRINT  " oscilloscope,  the  time  calibration  data  delay  time  will  be" 

4414  PRINT  " different  than  the  device  under  test  IDUT)  waveform  delay.  " 

4416  PRINT  " Time  calibration  data  is  not  valid  for  a DUT  waveform  " 

4418  PRINT  " which  has  a different  delay  time.  " 

4420  I 

4422  PRINT  TABXY(1 ,21  );"The  current  channel  is  ",Chnnl 

4424  INPUT  "is  this  the  correct  channel  ? Y/N  ",Ch$ 

4426  IF  (Ch$  = "n"!  OR  (Ch$  = "N")  THEN  GOSUB  Get_chn 

4428  I 

4430  CLEAR  SCREEN 

4432  PRINT  TABXY(1 ,24);"Please  set  up  the  waveform  and 

4434  PRINT  "press  continue  when  done." 

4436  LOCAL  707 

4438  CALL  Pause_key_on 

4440  OFF  KEY 

4442  GOSUB  Tcal_scope 

4444  RETURN 

4446  I 

4448  !*### * ****** **.*...*****.**..**.*...*#*. 

4450  ! 

4452  Chnl_err:  I 
4454  BEEP 

4456  DISP  "Input  out  of  range  or  disallowed  value." 

4458  WAIT  Paused 

4460  DISP  "Try  again  ..." 

4462  Get  chn:  ! 

4464  ON  ERROR  GOTO  Chnl_err 

4466  Test$  ="" 

4468  INPUT  "Enter  the  acquisition  channel  number  (1-4}.”,Test$ 
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4470  IF  LEN(Test$)  < 1 THEN  RETURN 

4472  Temp  = VAL(Test$) 

4474  OFF  ERROR 

4476  IF  (Temp<1)  OR  (Temp >4)  THEN  GOTO  Chnnl  error 
4478  OUTPUT  @Scope;"BLANK  CHANNEL" &VAL$(Chnnl) 

4480  Chnnl=Temp 

4482  OUTPUT  @Scope;"VIEW  CHANNEL" &VAL$(Chnnl) 

4484  I The  number  of  point  can  only  be  changed  from  the  controller. 

4486  RETURN 

4488  I 

4490  !*♦•** I..*..#*#*#####*###.*.**#..#*###**.*  i 

4492  ! 

4494  Volterr:  I 
4496  GOSUB  Beeps 

4498  DISP  "ERROR  IN  READING  VALUE  OR  VALUE  OUT  OF  RANGE,  TRY  AGAIN." 

4500  WAIT  Paused 


4502 

4504 

4506 

4508 

4510 

4512 

4514 

4516 

4518 

4520 

4522 

4524 

4526 

4528 

4530 

4532 

4534 

4536 

4538 


lnput_volts:  I 

ON  ERROR  GOSUB  Volterr 
Test$  = "" 

INPUT  "Enter  the  volts  per  division  in  volts  ...",Test$ 

IF  LEN(Test$)  < 1 THEN  RETURN 
GOSUB  Data_check 

IF  (Rtemp<(Atten*.001))  OR  (Rtemp>(Atten#.080))  THEN  GOTO  Volterr 
Tc_volt  = Rtemp 
T c_vrange  = T c_volt  * 8 

OUTPUT  707;":CHANNEL"&VAL$(Chnnl)&":RANGE  "&VAL$(Tc_vrange) 
OFF  ERROR 
Print_volts:  ! 

PRINT  TABXYd  ,5);Orange$; 

CALL  Auto_format(Tc_volt) 

IF  NOT  (Tcaljntrpt)  THEN  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 
RETURN 

! 


4540  Offset_err:  ! 

4542  GOSUB  Beeps 

4544  DISP  "ERROR  IN  READING  VALUE  OR  VALUE  OUT  OF  RANGE,  TRY  AGAIN." 
4546  WAIT  Paused 

4548  lnput_offset:  ! 

4550  ON  ERROR  GOTO  Qffset_err 

4552  Test$  = "" 

4554  INPUT  "Enter  the  offset  in  volts  ...",Test$ 

4556  IF  LEN(Test$)  < 1 THEN  RETURN 

4558  GOSUB  Data_check 

4560  IF  ABS(Rtemp)  > 5.00E-1  THEN  GOTO  Offset_err 

4562  Tc_off  = Rtemp 

4564  OUTPUT  707;":CHANNEL"&VAL$(Chnnl)&":OFFSET  "&VAL$(Tc_off) 

4566  OFF  ERROR 

4568  Print_offset:l 

4570  PRINT  TABXYd  ,8);Orange$; 

4572  CALL  Auto_f ormat(T c_of f ) 

4574  IF  NOT  (Tcaljntrpt)  THEN  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4576  RETURN 

4578  ! 

4580  !** 


eett«ae*e*«««ee*ee***«**«*******«**»e*********« 


4582  ! 

4584  Choose_average:  ! 

4586  OFF  KEY 

4588  OFF  KNOB 

4590  OFF  KBD 

4592  CLEAR  SCREEN 

4594  GCLEAR 

4596  PRINT  l_blue$ 

4598  DIM  Dp$[80] 

4600  DIM  T$[52] 

4602  Dp$  = "Select  Average  " 

4604  T$  = " Available  Averages  (powers  of  2 ) 

4606  Intrprty  = !ntr_prty  + 3 

4608  CALL  Menu_scroll(Dp$,T$,Allowd$(*),1 2,1  ,What(*)) 

4610  lntr_prty  = lntr_prty-3 

4612  IF  What(1)<  >0  THEN  ! Aborted 

46 1 4 Taver  = VAL(Allowd  $ (What(  1 ))) 

4616  END  IF 

4618  Tcaijntrpt  = 3 

4620  ! 

4622  OUTPUT  @Scope;":ACQUIRE:TYPE  AVERAGE" 

4624  OUTPUT  @Seope;":ACQU!RE:COUNT  ™&VAL$(T_aver) 

4626  RETURN 

4628  Print_ave:  I 

4630  PRINT  TABXY(63,2);Orange$; 

4632  CALL  Auto_format(T_aver*  1 .0) 

4634  RETURN 

4636  I 

4638  !* ********************************** ***** 

4640  ! 

4642  Save_wave:  f 

4644  IF  Save$  = " YES  " THEN 

4646  Save$  = " NO  K 

4648  ELSE 

4650  Save$  = " YES  B 

4652  END  IF 

4654  Print_save:  ! 

4656  PRINT  TABXY(36,2);Orange$; 

4658  PRINT  Save$ 

4660  IF  NOT  (Tcaijntrpt)  THEN  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4662  RETURN 

4664  I 

4666  I ************************************  * * * * * * * * 

4668  ! 

4670  Freq  error:  ! 

4672  BEEP 

4674  DISP  "ERROR  FREQUENCY  INPUT,  TRY  AGAIN." 

4676  WAIT  Paused 

4678  Input  freq:  I 

4680  ON  ERROR  GOTO  Freq_error 

4682  Test$  = "" 

4684  INPUT  "Enter  the  calibration  frequency. ..",Test$ 

4686  IF  LEN(Test$)  < 1 THEN  RETURN 

4688  GOSUB  Data_check 

4690  OFF  ERROR  " 

4692  IF  Rtemp<0  THEN  GOTO  Freq  error 
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4694  Freq  = Rtemp 

4696  Print_freq:  ! 

4698  PRINT  TABXY(2,2);Orange$; 

4700  CALL  Auto_format(Freq) 

4702  IF  NOT  (TcaIJntrpt)  THEN  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4704  RETURN 

4706  I 

4708  j*****#*****************************#**#*#****#**#*****#********** 
4710  I 

4712  Pair_error:  I 
4714  GOSUB  Beeps 

4716  DISP  "ERROR  IN  READING  VALUE  OR  DISALLOWED  VALUE,  TRY  AGAIN." 

4718  WAIT  Paused 

4720  Point_pairs:  I 

4722  ON  ERROR  GOTO  Pair_error 

4724  Test$  ="" 

4726  DISP  "Enter  the  point  pairs  for  the  linear  least  squares  fit." 

4728  WAIT  Paused 

4730  INPUT  " This  must  be  a positive,  integer  number. ",Test$ 

4732  IF  LEN(Test$)  < 1 THEN  RETURN 

4734  Temp  = VAL(Test$) 

4736  OFF  ERROR 

4738  IF  Temp<1  THEN  GOTO  Pair_error 

4740  Ls_prs  = Temp 

4742  Print_pairs:  I 

4744  PRINT  TABXY(35,9);Orange$; 

4746  CALL  Auto_format(Ls_prs*  1 .0) 

4748  IF  NOT  (TcaIJntrpt)  THEN  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4750  RETURN 

4752  I 

!***#ftt##***********#****#*#*e#****#****ft**#**#ft**#**##**s*******e 

4756  ! 

4758  Which_slope:  ! 

4760  IF  Slope  THEN 

4762  Slpe$  = " - SLOPE  " 

4764  Slope  = 0 

4766  ELSE 

4768  Slpe$  = ” + SLOPE  " 

4770  Slope  = 1 

4772  END  IF 

4774  Print_slope:  I 

4776  PRINT  TABXY(35,5);Orange$; 

4778  PRINT  Slpe$ 

4780  IF  NOT  (TcaIJntrpt)  THEN  CALL  Se!ect_graphics(T_which,Tlast,Co_ords(*)) 

4782  RETURN 

4784  I 

4786  i***************************************************************** 
4788  ! 

4790  Moving_error:  ! 

4792  GOSUB  Beeps 

4794  DISP  "ERROR  IN  READING  VALUE  OR  DISALLOWED  VALUE,  TRY  AGAIN." 

4796  WAIT  Paused 

4798  DISP  "This  must  be  an  odd,  positive  integer  number." 

4800  WAIT  Paused 

4802  Moving_points:  ! 

4804  ON  ERROR  GOTO  Moving_error 
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4806  Test$  = "" 

4808  INPUT  "Enter  an  odd  number  of  points  for  the  moving  average. ",Test$ 
4810  IF  LEN(Test$)  < 1 THEN  RETURN 

4812  Temp  = VAl(Test$) 

4814  OFF  ERROR 

4816  IF  Temp  <1  THEN  GOTO  Movingerror 

4818  IF  NOT  (Temp  MOD  2)  THEN  GOTO  Moving  error 
4820  Zero_x  = Temp 

4822  Print_sld_ave:  ! 

4824  PRINT  TABXY(63,6);Orange$; 

4826  CALL  Auto_format(Zero_x*  1 .0) 

4828  IF  NOT  (TcaIJntrpt)  THEN  CALL  Select_graphics(T_which,Tlast,Co_ords(*)) 

4830  RETURN 

4832  ! 

4834  \****** 

4836  ! 

4838  Trig_lev_err:  I 

4840  GOSUB  Beeps 

4842  DISP  "ERROR  IN  READING  DELAY,  TRY  AGAIN." 

4844  WAIT  Paused 

4846  Trigger Jvl:  I 

4848  ON  ERROR  GOTO  Trigjev_err 

4850  Test$  = "" 

4852  INPUT  "Enter  the  desired  trigger  level  in  volts. ",Test$ 

4854  IF  LEN(Test$)<  1 THEN  RETURN 

4856  GOSUB  Data_check 

4858  IF  (Rtemp<-1 .)  OR  (Rtemp>1.)  THEN 

4860  GOSUB  Beeps 

4862  DISP  "VALUE  OUT  OF  RANGE.  Please  try  again." 

4864  WAIT  1.0 

4866  GOTO  Trigger  lvl 

4868  END  IF 

4870  T_trig  = Rtemp 

4872  OUTPUT  @Scope;":TRIGGER:LEVEL  "&VAL$(T_trig) 

4874  OFF  ERROR 

4876  Print_trig_lev:  ! 

4878  PRINT  TABXY(60,9);Orange$; 

4880  CALL  Auto_format(T_trig) 

4882  IF  NOT  (TcaIJntrpt)  THEN  CALL  SelectjgraphicsfTJwhich,Last1  ,Co_ords(*)) 
4884  RETURN 

4886  ! 

4888  !****♦•* * *************************************** 

4890  ! 

4892  Tcal_data:  ! 

4894  ! 

4896  I 

4898  ! Time_data  is  stored  as  follows: 

4900  I Time_data(i,  1 ) = time  of  zero  crossing, 

4902  I Time_data(i,2)  = point  number  of  zero  crossing, 

4904  ! Time_data(kount  + 1 ,1 ) = Actual  time  window, 

4906  I Time_data(kount  + 2,1 ) = scope  time  window  (10  * time_per_div), 

4908  ! Time_data(kount  + 3,1 ) = kount  (number  of  zero  crossings  found), 

4910  ! Time_data(kount  + 4,1 ) = number  of  points  acquired. 

4912  ! 

4914  Kill  meas  = 0 

4916  Do  meas  = 1 
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4918  OFF  KEY 

4920  OFF  KBD 

4922  OFF  KNOB 

4924  WHILE  NOT  (Kill_meas)  AND  (Do  meas) 

4926  ON  KEY  0 LABEL  "ABORT  ",Local_prty + 5 GOTO  Abort_tmeas 

4928  IF  Do  meas  THEN  GOSUB  Get  twave 

4930  END  WHILE 

4932  IF  NOT  (Kill_meas)  THEN 

4934  GOSUB  Con_to_volts 

4936  GOSUB  Sliding_ave 

4938  GOSUB  Linearjit 

4940  GOSUB  Crossing  point 

4942  IF  Save$  = " YES  "THEN 

4944  DISP  "A  description  of  the  time  calibration  waveform  required;" 

4946  WAIT  Paused 

4948  INPUT  "enter  data  description,  40  chrs  or  less.  ",Data_id$ 

4950  Intr _prty  = Local_prty  + 1 

4952  CALL  Data_to_disk_r(1,INT(Pnts),Voltage(*),DataJd$) 

4954  Intr  prty  = Local  prty 

4956  END  IF 

4958  OFF  KEY 

4960  CLEAR  SCREEN 

4962  PRINT  TABXYd  ,1 );  "There  were  ";Time_data(Kount  + 3,U; 

4964  PRINT  "zero  crossings  and  ";Time_data(Kount  + 4, 1 );" points  acquired." 

4966  PRINT  "The  time  window  as  calculated  against  the  time  standard  "; 

4968  PRINT  "is  ";Time_data(Kount+  1 ,1 );"." 

4970  PRINT  "The  time  window  that  the  oscilloscope  reports  is  ";Time_data(Kount  + 2,1);V 

4972  INPUT  "Is  the  data  Okay?  y/n",Ch$ 

4974  IF  Ch$  = "n"  OR  Ch$  = "N"  THEN 

4976  DISP  "Please  re-set  the  measurement  and  try  again." 

4978  WAIT  1.5 

4980  CLEAR  @Scope 

4982  ELSE 

4984  DISP  "Enter  in  the  description  of  the  time  "; 

4986  INPUT  "calibration  data,  40  characters  or  less.  ",Data_id$ 

4988  lntr_prty  = Local_prty  + 1 

4990  CALL  Data_to_disk_r(  1 ,Kount  + 4,Time_data(*),Datajd$) 

4992  lntr_prty  = Local  prty 

4994  END  IF 

4996  DEALLOCATE  Voltaged) 

4998  DEALLOCATE  Xcrossd) 

5000  DEALLOCATE  Time  data(*) 

5002  DEALLOCATE  XpntsC) 

5004  END  IF 

5006  Teal  intrpt  = 3 

5008  OFF'kEY 

5010  RETURN 

5012  I 

5014  * * ***** 

5016  ! 

5018  Abort_tmeas:  ! 

5020  CLEAR  @Scope 

5022  LOCAL  @Scope 

5024  Kill_meas  = 1 

5026  CLEAR  SCREEN 

5028  DISP  Red$;"MEASUREMENT  ABORTED" 
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5030  OFF  KEY 

5032  OFF  KNOB 

5034  OFF  KBD 

5036  OFF  ERROR 

5038  OFF  TIMEOUT  7 

5040  Tealjntrpt  = 3 

5042  GOTO  Tcal_scope 

5044  I 

5046  !** ******************************************* 

5048  ! 

5050  Data_error:  8 

5052  GOSUB  Beeps 

5054  DISP  "ERROR  IN  READING  SCOPE.  WILL  TRY  AGAIN" 

5056  Get_twave:  ! 

5058  Do  jneas  = 0 

5060  Try_again  = 1 

5062  Get_again:  ! 

5064  IF  NOT  (Kill_meas)  THEN 

5066  ON  ERROR  GOTO  Datajsrrof 

5068  QUTRjT  #Scope;"*CLS" 

5070  WAIT  1 

5072  OUTPUT  @Scope;":TER?" 

5074  ENTER  @Scope;Ter$ 

5076  IF  (VAL(Ter$X  > 1 » THEN 

5078  GOSUB  Beeps 

5080  DISP  "No  signal  detected;  please  check  the  setup.” 

5082  WAIT  2 

5084  CLEAR  SCREEN 

5086  OFF  KEY 

5088  OFF  KNOB 

5090  OFF  KBD 

5092  OFF  ERROR 

5094  CALL  ScopeJnit(Err_flg) 

5096  IF  Err_flg  THEN  Interrupted  = 1 

5098  TcaMntrpt  = 3 

5100  SUBEXIT 

5102  END  IF 

5104  DISP  "System  busy...." 

5106  OUTPUT  @Scope;":TIMEBASE:DELAY  ”&VAL$(Dly) 

5108  OUTPUT  @Scope;":TIMEBASE:RANGE  "&VAL$(Trange) 

5110  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":OFFSET  "&VAL$(Tc_off) 

5112  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":RANGE  "&VAL$(Tc_vrange) 

5114  OUTPUT  @Scope;":ACQUIRE:TYPE  AVERAGE" 

5116  OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(T_aver) 

5118  OUTPUT  @Scope;":ACQUIRE:POINTS  "&VAL$(Pnts) 

5 1 20  OUTPUT  @Scope;"  * CLS" 

5122  OUTPUT  @Scope;"*SRE  32;#ESE  1" 

5124  OUTPUT  @Scope;":DIGITIZE  CHAN"&VAL$(Chnnl)&";#OPC” 

5126  ! 

5128  ! Jhe  following  loop  enables  a keyboard  abort  key  to  be 

5130  8 processed. 

5132  8 The  ABORT  command  is  processed  in  the  Tcal_data  block. 

5134  WHILE  NOT  B8T(Statf5) 

5136  Stat  = SPOLL(@Scope) 

5138  END  WHILE 

5140  OUTPUT  @Scope;":SYSTEM:HEADER  OFF;:EOI  ON” 
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5142  OUTPUT  @Scope;"WAVEFORM:SOURCE  WMEMORY"&VAL$(Chnnl)&";  FORMAT  WORD" 

5144  OUTPUT  @Scope;"WAVEFORM:DATA?" 

5146  ENTER  @Scope  USING  "#,A,D";Header$, Bytes 

5148  IF  Bytes  = 3 THEN 

5150  ENTER  @Scope  USING  "#,3D";Length 

5152  END  IF 

5154  IF  Bytes  = 4 THEN 

5156  ENTER  @Scope  USING  "#,4D";Length 

5158  END  IF 

5160  Length  = Length/2 

5162  IF  Pnts  < > Length  THEN 

5164  DISP  "The  scope  will  not  allow  ", Pnts, "points." 

5166  WAIT  Paused 

5168  DISP  "The  number  of  points  is  now  ", Length,"." 

5170  WAIT  Paused 

5172  Pnts  = Length 

5174  END  IF 

5176  REDIM  Wav(Length) 

5178  ENTER  @Scope  USING  "#,W";Wav(*} 

5180  ENTER  @Scope  USING  "-K,B";End$ 

5 1 82  OUTPUT  @Scope;":WAVEFORM:YINCREMENT?" 

5184  ENTER  @Scope;Yinc 

5 1 86  OUTPUT  @Scope;": WAVEFORM: YORIGIN?" 

5 1 88  ENTER  @Scope;Yorg 

5 1 90  OUTPUT  @Scope;":WAVEFORM:YREFERENCE?" 

5 1 92  ENTER  @Scope;Yref 

5 1 94  OUTPUT  @Scope;" : WAVEFORM:XINCREMENT?" 

5 1 96  ENTER  @Scope;Xinc 

5198  OUTPUT  @Scope;":WAVEFORM:XORIGIN?" 

5200  ENTER  @Scope;Xorg 

5202  OUTPUT  @Scope;":WAVEFORM:XREFERENCE?" 

5204  ENTER  @Scope;Tref 

5206  OFF  ERROR 

5208!  Bugl  = 1 

5210  IF  Bugl  THEN 

5212  FOR  I = 1 TO  Pnts 

5214  PRINTER  IS  PRT 

5216  PRINT  Wav(l),"  ",l 

5218  NEXT  I 

5220  PRINTER  IS  CRT 

5222  Bugl  =0 

5224  END  IF 

5226  END  IF 

5228  RETURN 

5230  ! 

5232  ! 

5234  ! 

5236  Con_to  volts:  ! 

5238  ALLOCATE  Voltage(Pnts,2) 

5240  FOR  I = 1 TO  Pnts 

5242  Voltage(l,2)  = ((Wav(l)-Yref ) * Yinc)  + Yorg 

5244  Voltage(l,1 ) = ((l-Tref)*Xinc)  + Xorg 

5246  NEXT  I 

5248  RETURN 

5250  ! 

5252  * 
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5254  ! 

5256  Sliding_ave:  ! 

5258  ALLOCATE  REAL  Xcross(IOO) 

5260  ALLOCATE  Xpnts(Pnts) 

5262  Kount  = 0 

5264  Int  temp  = Zero  x DIV  2 

5266  GOSUB  Mid 

5268  Zero  Jevel  = (Midval * 1 .OP  (Zerojc  * 1 ,0! 

5270  Slide_ave  = O.-Zerojevel 

5272  FOR  7-1  TO  Zero_x 

5274  Xpnts(l)  - I 

5276  Slide  ave- Slide  ave  + Wav(l) 

5278  NEXT  I ” 

5280  FOR  I - Zero_x  + 1 TO  Pnts 

5282  Xpnts(l)  = ! 

5284  Prev^ave  = Slide^ave 

5286  Slide^ave  - Slide_ave  + Wav(l)-Wav(l“Zero_x) 

5288  IF  ((Prev_ave*Slide_ave<0)  OR  (Slide_ave  = 0))  THEN 

5290  ! a change  in  sign  indicates  a zero  crossing. 

5292  ! 

5294  INegative  slope  crossing 

5296  ! 

§298  IF  (NOT  Slope)  AND  ( (Slide  jave-PrevjiveK  ~0j  THEN 

5300  Kount  - Kount  + 1 

5302  Xcross(Kount) -l-lnt_temp 

5304  END  IF 

5306  I 

5308  ! Positive  slope  crossing 

5310  I 

5312  IF  (Slope)  AND  ((Slide_ave-Prev_ave)  > -0.)  THEN 

5314  Kount  = Kount  + 1 

5316  Xcross(Kount)  - l-lnt_temp 

5318  END  IF 

5320  END  IF 

5322  NEXT  I 

5324  RETURN 

5326  S 

5330  ! 

5332  Mid:  ! 

5334  Maxval  = Wav(  1 )*  1 .0 

5336  Minval  =Wav(1  P 1 .0 

5338  FOR  I = 1 TO  Pnts 

5340  IF  (Wav(l)#1.0)>  Maxval  THEN  Maxval  =Wav(l)#  1 .0 

5342  IF  (Wav(l) * 1 .0)  < Minval  THEN  Minval  = Wav(l)  * 1 .0 

5344  NEXT  I 

5346  Midval  = INT((Maxval  + Minval)/2) 

5348  RETURN 

5350  I 

5352  |********®*®****®®*®*«®®***®«*®®®®*®®®®®®®*®®®®®®®*®®®®®**®**®*®®® 
5354  ! 

5356  Crossing_point:  I 
5358  f 

5360  ALLOCATE  Time_data(Kount  + 4,2) 

5362  ! 

5364  ! Time  data  is  stored  as  follows: 
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5366  ! Time_data(i,1)=time  of  zero  crossing, 

5368  ! Time_data(i,2)  = point  number  of  zero  crossing, 

5370  ! Time_data  (kount  + 1)=  Actual  time  window, 

5372  ! Time_data(kount  + 2)  = scope  time  window  (10  * time_per_div), 

5374  ! Time_data(kount  + 3)  = kount  (number  of  zero  crossings  found), 

5376  ! Time_data(kount  + 4)  = number  of  points  acquired. 

5378  ! 

5380  INTEGER  K 

5382  Period  * 1 /Freq 

5384  Scale_fact  = Period/(Xcross(2)-Xcross(U)  ! Scale_fact  is  the  number 
5386  ! for  converting  point  numbers  to 

5388  !a  time  value. 

5390  Time_data(1 , 1 ) = Xcrossd ) * Scale_fact 
5392  Time_data(  1,2)  = Xcrossd) 

5394  FOR  K = 2 TO  Kount 

5396  Scale_fact  = Period/(Xcross(K)-Xcross(K-1 )) 

5398  Time_data(K,  1 ) = Xcross(K) * Scale_fact 

5400  Time_data(K,2)  = Xcross(K) 

5402  IF  Bugl  THEN 

5404  PRINTER  IS  PRT 

5406  PRINT  "time  data(",K,",1 ) = ",Time_data(K,1) 

5408  PRINT  "time”data(",K,",2)  = ",Time  data(K,2) 

5410  PRINTER  IS  CRT 

5412  END  IF 

5414  NEXT  K 

5416  Time_data  (Kount  + 1 ,1 ) =Time_data(Kount,1 ) + Scale_f  act  * (Pnts-Xcross (Kount)) 

5418  Time_data  (Kount  + 2,1 ) =Time_per_div*  1 0 

5420  Time_data  (Kount  + 3,1)  = Kount 

5422  Time  data  (Kount + 4,1 ) = Pnts 

5424  RETURN 

5426  ! 

5428  ! * * * ******** 

5430  ! 

5432  Linear  fit:  ! 

5434  ALLOCATE  B(2,1) 

5436  ! B(1,1)  is  the  intercept,  B(2,1)  is  the  slope. 

5438  I of  the  line  which  best  fits  the  data  around  a 

5440  I particular  data  point. 

5442  INTEGER  Xval 

5444  IF  (Xcrossd  )<Ls_prs)  THEN 

5446  GOSUB  Beeps  , 

5448  DISP  "The  initial  zero  crossing  is  too  dose  to  the  left- 

5450  WAIT  Paused  ' 

5452  DISP  "side  of  the  scope  display  and  has  been  omitted." 

5454  WAIT  Paused 

5456  FOR  I = 1 TO  Kount-1 

5458  Xcrossd)  - Xcrossd  + 1 ) 

5460  NEXT  I 

5462  Kount  = Kount-1 

5464  END  IF 

5466  IF  ((Pnts-Xcross(Kount))<Ls_prs)  THEN 

5468  DISP  "The  last  zero  crossing  is  too  close  to  the  right- 

5470  WAIT  Paused 

5472  DISP  "side  of  the  scope  display  and  has  been  omitted." 

5474  Kount  = Kount-1 

5476  END  IF 
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5478  FOR  I = 1 TO  Kount 

5480  Xval  = Xcross(l)-Ls_prs 

5482  CALL  StraightJine(XvaUNT(Ls_prs),B(*» 

5484  IF  B(2,1)<>0  THEN 

5486  Xcross(l)  = ((1 .0*Midva!)-B(1 ,1  ))/B(2  ,1 ) 

5488  END  IF 

5490  NEXT  l 

5492  DEALLOCATE  B(#) 

5494  RETURN 

5496  ! 


5500  ! 

5502  Data_check:  ! 

5504  ! The  following  is  a test  of  the  lower  case  e in  a number  of 

5506  ! scientific  notation.  If  a lower  case  e occurs,  it  is  converted 

5508  I to  upper  case.  That  is  all. 

5510  IF  POS(Test$("e")  THEN 
5512  Temps=POSfTest$,"e") 

5514  T@st$[Templ -”E"&Test$[Temp  + 1 ,LEN(Test$)j 

5516  END  IF 

5518  8 end  of  lower  case  conversion 

5520  Rtemp  ~ VALfT est $ ) 

5522  RETURN 


5526  1*®*®®*'*'®**®**®®****''*'*®'*®*®'*'*'®*#®**'®*®**®®®'®'*®®®®®'*'*®*®'®***®®®*®®'* 
5528  ! 

5530  Beeps:  ! 

5532  BEEP  400, .25 

5534  BEEP  600, .50 

5536  BEEP  400, .25 

5538  RETURN 

5540  ! 

5542  SUBEND 
5544  ! 

5546  ! ®®®®®***®®®®®®®**®#®®®*®®®®®'s®#*®®'s,®®4'®®®*®*®®®®®®®®®##®'®''s>'e,# 

5548  ! 

5550  SUB  Straight JinedNTEGER  Xval , Ls  ^points, REAL  B(#)) 

5552  Straightjine:  I 

5554  OPTION  BASE  1 

5556  COM  /Line Jit/  INTEGER  Wav(1024) 

5558  DEG 

5560  ALLOCATE  REAL  Mtnc(Ls_points,2),Transps(2,Ls_points),Temp_mat(2,2) 

5562  ALLOCATE  REAL  Temp_str(2,Ls  points), Vectr(Ls_points) 

5564  INTEGER  Half_pnts 

5566  f 

5568  Half_pnts  = Ls_points  DIV  2 

5570  FOR  I = 1 TO  Ls_points 

5572  Mtrx(l,1 ) = 1 

5574  Mtrx(l,2)  = Xval-Half  _pnts  + 1-1 

5576  Vectr(l)  = Wav  (Xval-Half  _pnts  + 1-1 ) 

5578  NEXT  I 

5580  MAT  Transps=  TRN(Mtrx) 

5582  MAT  Temp  mat-  Transps*Mtnc 

5584  MAT  Temp_mat=  INV(Temp_mat) 

5586  MAT  Tempstr  - Temp_mat#Transps 

5588  MAT  B=  Temp  str* Vectr 
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5590  SUBEXIT 

5592  SUBEND 
5594  ! 

5596  ! 

5598  I 

5600  SUB  Pause_key_on 

5602  Pause_key_on:  I Make  sure  that  CONTINUE  key  exists. 

5604  I Original:  02  Dec  1 987 

5606  I Revision:  02  Dec  1987 

5608  COM  /Sys/  Sys  id$[10] 

5610  IF  Sys  id$[1 ,4]  = "S300"  THEN  I reset  to  S300  system  keys 

56 1 2 CONTROL  KBD,  1 5;0 

5614  CONTROL  CRT,  1 2;2 

5616  LOAD  KEY 

5618  END  IF 

5620  PAUSE 

5622  IF  Sys  id$l1,41  = -S300"  THEN  I set  to  S200  compatible  keys 
5624  OUTPUT  KBD  USING  "K,#";"SCRATCH  KEYX" 

5626  CONTROL  KBD,  15,1 

5628  CONTROL  CRT,  1 2,0 

5630  END  IF 

5632  SUBEXIT 

5634  SUBEND 

5636  I 

5638  ! 

5640  SUB  Auto_format(Value) 

5642  Auto_format:  I Original:  1 3 Nov  1 984 

5644  1 Revision:  06  Aug  1 987 

5646  I Select  the  proper  number  of  digits  to  display. 

5648  I This  routine  is  used  by  several  program  sections  to 

5650  ! print  numbers  to  the  display. 

5652  I 

5654  SELECT  ABS(Value) 

5656  CASE  1 .0  TO  99999.99 

5658  IF  Value  = PROUND(Value,-2)  THEN 

5660  IF  INT(Value)  = Value  THEN 

5662  PRINT  USING  "#,M5D,6X";Value 

5664  ELSE 

5666  PRINT  USING  "#,M5D.DD,3X-;Value 

5668  END  IF 

5670  ELSE 

5672  PRINT  USING  "#,MD.4DESZZ,X";Value 

5674  END  IF 

5676  ! 

5678  CASE  >99999.99 

5680  PRINT  USING  "*,MD.3DESZZZ,X";Value 

5682  I 

5684  !+  + + + + + AII  values  less  that  1.0  ++++++++++ 

5686  I 

5688  CASE  .0001  TO  1 

5690  IF  PROUND(Value,-4)  = Value  THEN 

5692  PRINT  USING  "#,4X,MZ.4D,X*;Value 

5694  ELSE 

5696  PRINT  USING  "#,MD.4DESZZ,X";Value 

5698  END  IF 

5700  I 
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5702  CASE  1.0E-99  TO  .0001 

5704  PRINT  USING  "#,MD.4DESZZ,X";Value 

5706  ! 

5708  CASE  1 .QE-300  TO  1.0E-99 

5710  PRINT  USING  -#,MD.3DESZZZ,X";Value 

5712  CASE  ELSE 

5714  PRINT  USING  "#f4X,MZ.D,4X";Value 

5716  END  SELECT 

5718  SUBEXIT 

5720  SUBEND 

5722  I 

5724  ! * ***6se**# 

5726  I 

5728  SUB  ScopeJnitONTEGER  Err_flg) 

5730  Scope  Jnit:  I 
5732  ! 

5734  COM  /Scope/  REAL  Time_per_div,Volts,Trange,VrangefDly 

5736  COM  /Scope/  REAL  Probe_fac, Offs, Trig, Atten 

5738  COM  /Scope/  INTEGER  Aver,Pnts,Chnnl 

5740  COM  /Scope/  Type${30LRefer$[141,@Scope,Mode$[30] 

5742  COM  /Teal_vals/  INTEGER  Zero  x,Ls_prs,SlopecT_avertREAL  Freq 

5744  COM  /Tcafvals/  Slpe$[10], Save $[101  REAL  Te_off,Tc_voltfTjrig 

5746  COM  /Vcaf vals/  INTEGER  V_aver,lntervalfREAL  Vjstep.Vjnin 

5748  I 

5750  I 

5752  Err_flg  = 0 In©  errors  yet. 

5754  Try_again-1 

5756  GOSUB  Doagain 

5758  SUBEXIT 

5760  lnit_err:  I 

5762  BEEP 

5764  DISP  "Something  went  wrong  during  initialization.  Will  try  again." 

5766  WAIT  1.5 

5768  Do_again:  ! 

5770  ON  ERROR  GOTO  lnit_err 

5772  ON  TIMEOUT  7,2  GOTO  Time_out_error 

5774  CLEAR  707  Iclears  the  HPIB  to  the  scope 

5776  ASSIGN  ©Scope  TO  707 

5778  OUTPUT  @Scope;"*RST"  IPuts  the  scope  in  a known  state. 

5780  IThe  rest  puts  the  scope  in  a more  useful  state. 

5782  OUTPUT  ©Scope;" BLANK  CHANNEL  1’ 

5784  OUTPUT  @Scope;"  BLANK  CHANNEL2" 

5786  OUTPUT  @Scope;" BLANK  CHANNELS" 

5788  OUTPUT  @Scope;"BLANK  CHANNEL4" 

5790  OUTPUT  @Scope;":DISPLAY:GRATICULE  GRID- 

5792  OUTPUT  ©Scope;" :DISPLAY:FORMAT  1" 

5794  IF  Refer$  - " CENTER  "THEN 

5796  OUTPUT  @Scope;"TIMEBASE:REFERENCE  CENTER- 

5798  ELSE 

5800  OUTPUT  @Scope;"TIMEBASE:REFERENCE  LEFT- 

5802  END  IF 

5804  OUTPUT  @Scope;" :T!MEBASE: RANGE  "&VAL$|Trange| 

5806  OUTPUT  @Scope;":TIMEBASE:DELAY  "&VAL$(Dly) 

5808  OUTPUT  @Scope;":TIMEBASE:MODE  “&Mode$ 

5810  OUTPUT  @Scope;"VIEW  CHANNEL" &VAL$(Chnnl» 

5812  OUTPUT  @Scope;":CHANNEL"&VAL$(Chnnl)&":OFFSET  B&VAL$(Offs) 
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5814 

5816 

5818 

5820 

5822 

5824 

5826 

5828 

5830 

5832 

5834 

5836 

5838 

5840 

5842 

5844 

5846 

5848 

5850 

5852 

5854 

5856 

5858 

5860 

5862 

5864 

5866 

5868 

5870 

5872 

5874 

5876 

5878 

5880 

5882 

5884 

5886 

5888 

5890 

5892 

5894 

5896 

5898 

5900 

5902 

5904 

5906 

5908 

5910 

5912 

5914 

5916 

5918 

5920 

5922 

5924 


OUTPUT  @Scope;"  :CHANNEL"  &VAL$  (Chnnl)&"  :RANGE  "&VAL$(Vrange) 
OUTPUT  @Scope;":ACQUIRE:TYPE  "&Type$ 

OUTPUT  @Scope;":ACQUIRE:COUNT  "&VAL$(Aver) 

OUTPUT  @Scope;’:ACQUIRE:POINTS  "&VAL$(Pnts) 

OUTPUT  @Scope;":ACQUIRE:BANDWIDTH  HIGH" 

OFF  TIMEOUT  7 
OFF  ERROR 
RETURN 

Time  out  error:  ! 

IF  Try_again>5  THEN 
OFF  TIMEOUT  7 
OFF  ERROR 
BEEP 

DISP  "Scope  not  responding. ..command  aborted” 

WAIT  1 
Err_flg  = 1 
CLEAR  SCREEN 
SUBEXIT 
END  IF 
BEEP 

DISP  "Scope  not  responding. ..will  try  again." 

WAIT  1 . 

CLEAR  SCREEN 
T ry_again = T ry_again  + 1 
GOTO  Do  again 
SUBEND 


! 

! 

! 

SUB  Select_graphics (INTEGER  Which, Lastl ,Co_ords(*)) 
Select_graphics:  I 

IF” Lastl  >0  THEN 

Lwrlftx  = Co  _ords(Last1 , 1 ) 

Lwrlfty  = Co_ords(Last1 ,2) 

Upperrtx  = Co_ords(Last1 ,3) 

Upperrty  = Co  ords(Last1 ,4) 

PEN  -1 

FOR  1 = 1 TO  4 

MOVE  Lwrlftx, Lwrlfty 
RECTANGLE  Upperrtx,Upperrty 
Lwrlftx  = Lwrlftx-2 
Lwrlfty  = Lwrlfty-2 
Upperrtx  = Upperrtx  + 4 
Upperrty  = Upperrty  + 4 
NEXT  I 
END  IF 

Lwrlftx  = Co_ords(Which,  1 ) 

Lwrlfty  = Co_ords(Which,2) 

Upperrtx  =Co_ords(Which, 3) 

Upperrty  = Co_ords(Which, 4) 

PEN  1 

FOR  I = 1 TO  4 

MOVE  Lwrlftx, Lwrlfty 
RECTANGLE  Upperrtx, Upperrty 
Lwrlftx  = Lwrlftx-2 
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5926  Lwrifty  = Lwrlfty-2 

5928  Upperrtx  - Upperrtx  + 4 

5930  Upperrty  = Upperrty  + 4 

5932  NEXT  I 

5934  Lastl  * Which 

5936  SUBEXIT 
5938  SUBEND 
5940  ! 

5942  r ********************************************* 

5944  ! 

5946  SUB  Operatorjnfo 
5948  ! 

5950  Operator  info:  ! 

5952  I 

5954  COM  /Hue/  Rev_vid$msEnh_off$I1],Underline$m 

5956  COM  /Hue/  Red$niOrange$S1],LJ>lue$[1S 

5958  I 

5960  OFF  KEY 

5962  Interrupted  = 1 

5964  CLEAR  SCREEN 

5966  PRINT  L b!ue$ 

5968  PRINT  "This  program  performs  automatic  acquisition  of  waveforms'5 

5970  PRINT  "for  time  domain  analysis.,  " 

§972  PRINT 

5974  PRINT  "There  are  potentially  three  data  sets  required  per  calibration," 
5976  PRINT  "a  waveform  from  the  device  under  test  (DUT),  a time  ” 

5978  PRINT  "calibration  waveform  TCAL,  and  a set  of  voltage  calibration  " 

5980  PRINT  "waves  VCAL  (these  are  D.C.  values).  The  number  of  " 

5982  PRINT  "calibration  acquisitions  performed  is  entirely  " 

5984  PRINT  "up  to  the  operator." 

5986  PRINT 

5988  PRINT  "When  this  program  is  first  loaded  and  run,  the  oscilloscope" 

5990  PRINT  "will  be  reset  and  initialized  to  'default*  values.  " 

5992  PRINT  "There  after,  any  changes  made  are  saved  as  long  as  the  " 

5994  PRINT  "program  is  in  memory." 

5996  PRINT 

5998  PRINT  "Press  the  continue  key  when  ready  to  proceed." 

6000  CALL  Pause=key  on 

6002  CLEAR  SCREEN 

6004  BEEP 

6006  PRINT  Red$ 

6008  PRINT  "The  scope  MUST  be  set-up  in  the  WAVEFORM  MENU  before" 

6010  PRINT  "using  the  time  or  voltage  calibration  acquisition  routines." 

6012  PRINT 

6014  PRINT  "The  vertical  scale  is  fixed  irrespective  of  the  screen  " 

6016  PRINT  "display.  This  means  a full  waveform  will  be  acquired  even" 

6018  PRINT  "if  the  waveform  appears  clipped  on  the  screen." 

6020  PRINT  "You  can't  always  get  what  you  want." 

6022  PRINT  L_blue$ 

6024  PRINT  "Press  the  continue  key  when  ready  to  proceed." 

6026  CALL  Pause_key_on 

6028  CLEAR  SCREEN 

6030  PRINT  "All  values  not  selectable  from  a given  menu  are  in  " 

6032  PRINT  "memory.  This  is  done  to  reduce  the  chance  of  acquiring" 

6034  PRINT  "data  which  has  different  time  scales,  voltage  settings," 

6036  PRINT  "offset  level,  e.t.c.  If  a value  is  changeable  from  a " 
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6038  PRINT  ’menu  then  it  does  not  need  to  be  consistent  with  the  " 

6040  PRINT  "other  waveforms.  For  example,  the  voltage  offset  level  " 

6042  PRINT  "for  the  time  calibration  wave  does  not  need  to  be  the  same" 

6044  PRINT  "as  the  offset  level  for  the  DUT  wave;  the  timebase  parameters" 
6046  PRINT  "are  the  important  settings  in  this  case.  On  the  other  hand,  " 

6048  PRINT  "the  offset  must  be  equal  for  the  DUT  and  the  voltage  " 

6050  PRINT  "calibration  data  sets.  " 

6052  PRINT 

6054  PRINT  "And  so  on." 

6056  PRINT 

6058  PRINT  "All  instrument  connections  are  ,of  course,  done  manually." 

6060  PRINT 

6062  PRINT  "Press  continue  when  you  are  ready  proceed." 

6064  PRINT  Enh_off$ 

6066  CALL  Pause  key  on 

6068  CLEAR  SCREEN  “ 

6070  SUBEXIT 

6072  ! 

6074  I * * ***** 

6076  I 

6078  SUBEND 

6080  SUB  Data_to_disk_r  (INTEGER  Curve, Datacount, REAL  Basket_file(*),DataJd$) 
6082  Data_to_disk_r:  ! Original:  1 3 Nov  1 984 
6084  I Revision:  02  Dec  1987 

6086  IThis  routine  will  SAVE  data  files  on  the  disk  in  RAW  data  format. 

6088  OPTION  BASE  1 

6090  COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$(500] 

6092  COM  /Interrupts/  INTEGER  lntr_prty 

6094  INTEGER  Local_prty,Diskspace 

6096  DIM  Ac$[5],Status$[1],Tempfile$[14] 

6098  REAL  Dtime 

6100  OFF  KEY 

6102  Local_prty  = lntr_prty 

6104  Dtime  = 0. 

6106  I 

6108  ISelect  the  disk  drive  for  data  storage 

6110  ! 

6112  Selectdrive:  ! 

6114  GRAPHICS  OFF 

6116  OUTPUT  2 USING  "#,K";"K" 

6118  CALL  Select_disk 

6120  IF  Diskdrive  $ = "NO  DISK"  THEN  GOTO  Mistakeline 

6122  Choosefilename:  ! 

6124  Ac$  - "ABORT" 

6 1 26  Tempfile$  - Filenames 

6128  CALL  Enterfilename(Ac$) 

6130  IF  LEN(Filename$)  = 0 THEN 

6132  Filename  $ =Tempfile$ 

6134  GOTO  Mistakeline 

6136  END  IF 

6138  Send_to_disk:  I Create  file  and  save  information. 

6140  ON  ERROR  GOTO  Cant_savedata 

6 1 42  Diskspace  = INT((Datacount*  1 6.01/256)  + 2 

6144  CREATE  BDAT  Ms_path$&Filename$&Diskdrive$,Diskspace,256 

6146  Dtime  = TIMED  ATE 

6148  DISP  " SAVING  data  for  CURVE  # ";Curve;".  " 
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6150  Status  $ = "N" 

6152  ASSIGN  ©Datapath  TO  Ms_path$&Filename$&Diskdrive$ 

6154  OUTPUT  @Datapath;Status$ 

6156  OUTPUT  ©Datapath;Data_id$  140  chrs  description  if  single  curve. 

6158  OUTPUT  @Datapath;Datacount  (number  of  xy  points 

6160  OUTPUT  @Datapath;Datacount  Isize  of  array  (same  as  above! 
6162  OUTPUT  ©Data path; Basket  f ile( * ) 

6164  ASSIGN  ©Datapath  TO  * 

6166  OFF  ERROR 

6168  I 

6170  Mistakeline:OFF  KEY 
6172  LOOP 

6 1 74  EXIT  IF  TIMEDATE-Dtime  >1.8 

6176  END  LOOP 

6178  DISP  CHR$(1 2) 

6180  OUTPUT  2 USING  "#,K";"K" 

6182  SUBEXIT 

6184  I 

6186  S //////////////////////////////////////////////////////// 

6188  ! 

6190  Cant^savedata:  I 

6192  BEEP  500, .8 

6194  SELECT  ERRN 

6196  CASE  72,73,76,78,81,82,90,93 

6198  DISP  Diskdrive$;"  has  failed  or  is  not  available 

6200  DISP  " ....CONTINUE  to  try  again." 

6202  CALL  PauseJceyjon 

6204  Filename  $ -Tempfi!e$ 

6206  CASE  84,85 

6208  DISP  " This  disk  is  not  initialized 

6210  DISP  " ....CONTINUE  to  try  again." 

6212  CALL  PauseJceyjan 

6214  Filename$ -T@mpfile$ 

6216  CASE  55,64 

6218  DISP  " This  disk  is  full,  insert  new  floppy  and/or"; 

6220  DISP  B select  new  drive  ...CONTINUE  ° 

6222  CALL  PauseJceyjan 

6224  Filename^ -Tempfile$ 

6226  CASE  ELSE 

6228  CALL  Errortrap 

6230  GOTO  Send_to_disk 

6232  END  SELECT 

6234  GOTO  Selectdrive 

6236  I 

6238  SUBEND 

6240  ! 

6242  I*************************************************** 
6244  ! 

6246  SUB  Select_disk 
6248  Select_disk:  ! Original:  13  Nov  1984 
6250  I Revision:  02  Dec  1 987 

6252  OPTION  BASE  1 

6254  COM  /Files/  Diskdrive$t20],Filename$l14],Ms_=path$[500| 

6256  COM  /Interrupts/  INTEGER  Intr  prty 

6258  COM  /Sys_msi/  Msijd$ 

6260  COM  /Sys/  Sysjd$ 
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6262 

6264 

6266 

6268 

6270 

6272 

6274 

6276 

6278 

6280 

6282 

6284 

6286 

6288 

6290 

6292 

6294 

6296 

6298 

6300 

6302 

6304 

6306 

6308 

6310 

6312 

6314 

6316 

6318 

6320 

6322 

6324 

6326 

6328 

6330 

6332 

6334 

6336 

6338 

6340 

6342 

6344 

6346 

6348 

6350 

6352 

6354 

6356 

6358 

6360 

6362 

6364 

6366 

6368 

6370 

6372 


INTEGER  Local_prty,Dd,Pt,Choose(1) 

DIM  Disc  $ (30)  [60], Title  $ [40],Displ  $ [60] 

Local  prty  = lntr_prty 
OFF  KEY 
I 

I Define  the  disk  drives  available  for  this  system,  reserve  the 
I first  characters  for  the  drive  address  and  the  characters  after 
I the  - for  a description  of  the  drive. 

I 

I Example: 

I Disc$(1)  = ":, 700,0,0  HP  9133H  HARD  disk,  volume  0." 

! 

I 

Displ$  = " SELECT  DISK  DRIVE  ...  Abort  will  cancel.  " 

Title$  = " Available  disk  drives  for  this  system.  " 

Pt  = 1 I allow  only  one  select 
I 

IF  Diskdrive  $[  1,1  ]<  THEN  Diskdrive  $ = "’ 

IF  Msi  id$[1,1]<  THEN  Msi  id$  = SYSTEM$("MSI") 

IF  Msi_id$(1,1]<  THEN  I Must  be  HFS  subdirectory 

Ms_path$  =Msi_id$ [1,POS (Msi Jd 1]  I strip  off  subdirs 
IF  Ms_path$[LEN(Ms  path$);1]<  >"/"  THEN  Ms_path$  =Ms_path$&"/" 
Msi_id$  = Msi  id$[POS(Msi  id$,":"),LEN(Msi_id$)] 

END  IF 

Diskdrive  $ = TRIM  $ (Diskdrive  $) 

Msi  id$  =TRIM$(Msi_id$) 

IF  LEN(Diskdrive$)  >0  AND  LEN(Msi_id$)>0  THEN 
Disc  $ ( 1 ) = Diskdrive  $ &RPT  $ ("  ",17  -LEN  (Diskdrive  $ ) ) 

Disc$(1)  = Disc$(1)&"-  Last  selected  disk  drive." 

Dd  = 1 

IF  Diskdrive  $ < > Msi_id$  THEN 

Disc$(2)  = Msi_id$&RPT$("  ",1 7-LEN(Msi_id$)) 

Disc$(2)  = Disc$(2)&"-  Start-up  mass  storage  unit  specifier." 

Dd  = Dd  + 1 
ELSE 

Disc$(1 ) = Disc$(1  )&"  Start-up  MSUS." 

END  IF 
ELSE 

IF  LEN(Msi_id$)>0  THEN 

Disc$(1 ) = Msijd$&RPT$("  B,1 7-LEN(Msi_id$)) 

Disc$(1 ) = Disc$(1  )&"-  Start-up  mass  storage  unit  specifier." 

Dd  s 1 
ELSE 
Dd  - 0 
END  IF 
END  IF 
Disk:  I 

I customize  system  drives  here 

I Follow  format  with  - after  unit  specifier,  description  is 
I optional  but  recommended. 


Disc$(Dd  + 1)  = ":, 702,0 
Disc$(Dd  + 2)  = ":, 702,1 
Disc$(Dd  + 3)  = 703,0 

Disc$(Dd  + 4)  = ":,1400 


- HP  9122  dual  microfloppy  left  drive" 

- HP  9122  dual  microfloppy  right  drive" 

- HP  9125  single  5.25  floppy  drive" 

- HP  9133H  hard  disk  volume  1" 
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6374  I 

6376  Dd  = Dd  + 4 ! add  the  number  of  drive  specifiers  above 

6378  ! 

6380  IF  Sy s jd $ { 1 „4}  < > " S300"  THEN 

6382  Disc${Dd  + 1)  = ":,4J  - LEFT  internal  series  200s 

6384  Disc$(Dd  + 2)  = ":,4,0  - RIGHT  internal  series  200” 

6386  Dd-Dd  + 2 

6388  END  IF 

6390  ! 

6392  ! 

6394  lntr_prty  = Locaiprty  + 1 

6396  CALL  Menu_scroll(Displ$,Title$„Disc$(*),Dd,Pt,Choose(*)) 

6398  lntr_prty  = Local_prty-1 

6400  IF  Pt  = 0 THEN 

6402  Diskdrive $ = " NO  DISK" 

6404  ELSE 

6406  Dd  -POS(Disc$(Choose(Pt)h"-")-1  ! find  - 

6408  IF  Dd>5  THEN  I valid  msus 

6410  Diskdrive$  ^TRIM$(Disc$(Choose(Pt))[1  ,Dd]) 

6412  ELSE 

6414  DISP  " ERROR  in  reading  MSUS  from  string,  - chr  not  found.  B 

6416  BEEP 

6418  CALL  Pause Jceyjan 

6420  Diskdrive$ -"NO  DISK" 

6422  END  IF 

6424  END  IF 

6426  DiskselectediOFF  KEY 
6428  SUBEXIT 

6430  SUBEND 
6432  I 

6434  I .**«**e««*®«**««*o#C«««*****®*c«*«««e*S*«**<><>** 

6436  l 

6438  SUB  Enterfiiename(Ac$) 

6440  Enterfilename:  ! Original:  1 3 Nov  1 984 

6442  I Revision:  10  Dec  1990  includes  HFS  directories 

6444  OPTION  BASE  1 

6446  COM  /Files/  Diskdrive$[20LFilename$[14],Ms_path$[500] 

6448  COM  /Interrupts/  INTEGER  lntr_prty 

6450  INTEGER  l,Ascii_num,Maskflag,Namelength 

6452  DIM  Test$[256],Hfs_temp$[1 61] 

6454  Namelength  = 10 

6456  IF  LEN(Ms_path$)>0  THEN  OUTPUT  KBD  USING  "K,#";"#"&Ms_path$&"H" 

6458  DISP  " ENTER  HFS  directory  PATH  (no  file)"; 

6460  IF  Ac$  < > "PATH"  THEN 

6462  DISP  ",  ENTER  / for  HFS  ROOT  or  null  for  LIF..."; 

6464  END  IF 

6466  LINPUT  Hfs_temp$ 

6468  Hfs  temp$  =TRIM$(Hfs_temp$) 

6470  IF  LEN(Hfs_temp$)>0  THEN 

6472  IF  LEN(Hfsjemp$)>1  AND  Hfs_temp$(LEN(Hfsjemp$l;1]  < >"/"  THEN 

6474  Hfs  temp$  =Hfs_temp$&"/" 

6476  END  IF 

6478  IF  LEN(Hfs_temp$)  = 1 THEN  Hfsjemp$=BB 

6480  Namelength  = 1 4 

6482  END  IF 

6484  IF  Ac$  = "PATH"  THEN 
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6486 

6488 

6490 

6492 

6494 

6496 

6498 

6500 

6502 

6504 

6506 

6508 

6510 

6512 

6514 

6516 

6518 

6520 

6522 

6524 

6526 

6528 

6530 

6532 

6534 

6536 

6538 

6540 

6542 

6544 

6546 

6548 

6550 

6552 

6554 

6556 

6558 

6560 

6562 

6564 

6566 

6568 

6570 

6572 

6574 

6576 

6578 

6580 

6582 

6584 

6586 

6588 

6590 

6592 

6594 

6596 


Ms_path$  =Hfs_temp$ 

SUBEXIT 
END  IF 

IF  LEN(Filename$)>0  THEN  OUTPUT  KBD  USING  "K,#";"/T&Filename$&"H" 
Efn:  ! 

DISP  " ENTER  the  FILE  NAME  ...  "; 

SELECT  Ac$ 

CASE  "CAT" 

DISP  "(ENTER  CAT  mask*  or  ENTER  null  to  CAT)"; 

CASE  "ABORT" 

DISP  "(ENTER  null  to  ABORT)  "; 

CASE  "VALID" 

DISP  "(must  be  a VALID  name!)  "; 

END  SELECT 
UNPUT  Test$ 

Test$=TRIM$(Test$) 

IF  LEN(Test$)  =0  AND  Ac$  = "VALID"  THEN  GOTO  Enterfilename 
IF  LEN(Test$)  =0  THEN  Abortline 
IF  LEN(Test$)>Namelength  THEN 
BEEP 

DISP  "ERROR  in  NAME  ENTRY  - max  ";Namelength;"  chars,  you  have  "; 
DISP  LEN(Test$);"  " 

WAIT  1 .8 

OUTPUT  2 USING  "K,#";"#"&Test$&"H" 

GOTO  Efn 
END  IF 

IF  POS(Test$,"*")>  1 THEN 

Test$  =Test$H  ,POS(Test$,"*")-1] 

Maskf  lag  = 1 
ELSE 

Maskf  lag  - 0 
END  IF 

FOR  1 = 1 TO  LEN(Test$) 

Ascii_num  = NUM(Test$[ll) 

SELECT  Ascii_num 

CASE  65  TO  90,95,97  TO  122,48  TO  57 
(Allowed  characters 
CASE  ELSE 
BEEP 

DISP  "ERROR  in  NAME  ENTRY-ILLEGAL  CHARACTERS,  TRY  AGAIN.” 
WAIT  1.8 

OUTPUT  2 USING  "K,#";"#"&Test$&"H" 

GOTO  Efn 
END  SELECT 
NEXT  I 

IF  Maskflag  THEN 

Filename$  =Test$&"*" 

ELSE 

Filename$  =Test$ 

END  IF 

Ms _path$  =Hfs  temp$ 

SUBEXIT 

Abortline:Filename$  = "" 

IF  Ac$  = "CAT"  THEN  Ms_path$  = Hfs_temp$ 

SUBEXIT 

SUBEND 
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6598  ! 

6600  ! * * 

6602  ! 

6604  SUB  File_menu(Mask$,Ftype$,Fls$(*), INTEGER  Fls_cnt,Dir_on,Prt_on) 


6606  File_menu:  ! 


6608 

6610 

6612 

6614 

6616 

6618 

6620 

6622 

6624 

6626 

6628 

6630 

6632 

6634 

6636 

6638 

6640 

6642 

6644 

6646 

6648 

6650 

6652 

6654 

6656 

6658 

6660 

6662 

6664 

6666 

6668 

6670 

6672 

6674 

6676 

6678 

6680 

6682 

6684 

6686 

6688 

6690 

6692 

6694 

6696 

6698 

6700 

6702 

6704 

6706 

6708 


! Original:  29  Jun  1987,  G*  Koepke 
! Revision:  02  Dec  1987,  07:00 
OPTION  BASE  1 
DEG 

COM  /Sys/  Sys_id$(10J 

COM  /Files/  Diskdrive$[201,Filename$[141,Ms_path$[5001 

COM  /Interrupts/  INTEGER  Intr  prty 

COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

DIM  Directory  $ (600)180], Bd$  (600)17 11 

DIM  D$[80],T$l51Uds$[40].Stat$l1],Test$l256] 

INTEGER  Bd_cnt,File_ent,l,C_cnt,C0(1  ),Format_error,End_search 
IF  FIs  cnt>0  THEN  ALLOCATE  INTEGER  Choose(Fls_cnt) 
l 

I Catalog  the  disk  specified 
I 

End_search  = G 

REPEAT  I Generate  path  to  file  and  extract  file  name. 

ON  ERROR  GOTO  Cat=errors 
DISP  " Reading  the  Directory  ...  " 

IF  LEN(Ms_path$)>0  THEN 

MASS  STORAGE  IS  Ms_path$[1  ,LEN(Ms_path$)-1]&Diskdrive$ 
ELSE 

MASS  STORAGE  IS  Diskdrive$ 

END  IF 

CAT  TO  Directory $(*);NO  HEADER, COUNT  Filament 
OFF  ERROR 
I 

I set  up  array  of  legal  file  names* 

S 

Bd_cnt  - 0 
MAT  Bd$  - ("") 

FOR  S-1  TO  File=ent 

SELECT  Directory $(l){32, 36] 

CASE  Ftype$  ! Ftype$  ^ "BOAT  B or 

! Ftype$  = "PROG  " 

IF  LEN(Mask$)>0  THEN  ! Test  for  mask$ 

IF  Directory  $(l)[1  <LEN(Mask$)]  = Mask$  THEN 
Bd^cnt  - Bd_cnt  + 1 

Bd$(Bd_cnt)  = Directory $(l)(1;14]&"  - "&Ftype$ 

END  IF 
ELSE 

Bd_cnt  = Bd_cnt  + 1 

Bd$(Bd_cnt)  = Directory$(l)[1;14]&"  - "&Ftype$ 

END  IF 

CASE  "DIR  " I plus  all  "DIR  " listings 

Bd_ent  = Bd=cnt  + 1 

Bd$(Bd_cnt)  = Directory  $ (l)|1  ;1 4] &"  - DIR  • 

CASE  ELSE 
END  SELECT 
NEXT  I 

IF  LEN(Msj3ath$)  >0  AND  Bd  cnt>0  AND  Fls_cnt>0  THEN 
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6710 

6712 

6714 

6716 

6718 

6720 

6722 

6724 

6726 

6728 

6730 

6732 

6734 

6736 

6738 

6740 

6742 

6744 

6746 

6748 

6750 

6752 

6754 

6756 

6758 

6760 

6762 

6764 

6766 

6768 

6770 

6772 

6774 

6776 

6778 

6780 

6782 

6784 

6786 

6788 

6790 

6792 

6794 

6796 

6798 

6800 

6802 

6804 

6806 

6808 

6810 

6812 

6814 

6816 

6818 

6820 


Bd  _cnt  = Bd_cnt  + 1 

Bd$(Bd_cnt)  = " — MOVE  back  up  ONE  Directory  level." 
Bd_cnt  = Bd_cnt  + 1 

Bd$(Bd  cnt)  = " — RETURN  to  ROOT  Directory." 

END  IF 
I 

I set  up  file  menu 
! 

D$  = " Select  "&VAL$(Fls_cnt)&"  file  name(s)  for  data  entry." 

T$  = "List  of  "&Ftype$&" files  and  DIRs  on  "&Diskdrive$ 

IF  LEN(Mask$)>0  THEN 
T$=T$&"  mask  = "&Mask$ 

END  IF 

IF  Bd  cnt>0  THEN 

IF  Dir  on>0  THEN  GOSUB  Read  datajd 
IF  PrTon  THEN 

GOSUB  List_directory 
End_search  = 1 
ELSE 

C cnt  = Fls  cnt 
DfSP  CHR$(1 2) 

IF  Fls_cnt>0  THEN 

CALL  Menu_scroll(D$,T$,Bd$r),Bd_cnt,C_cnt,Chooser)) 
ELSE 

CALL  Menu_scrol  I (D $ ,T  $ , Bd  $ (# ) , Bd_cnt, C_cnt,  CO  ( * ) ) 

END  IF 
! 

I transfer  file  names  to  Fls$(#). 

I 

IF  C_cnt  = 0 THEN  I selection  process  aborted 
End_search  = 1 
MAT  Fls$  = ("") 

ELSE 

MAT  SORT  Chooser) 

FOR  I = 1 TO  C __cnt 

IF  Bd$(Choose(l))[1 8,22]  =Ftype$  THEN 
Fls$(l)  = Bd$(Choose(l))[1  ;1 4] 

End_search  = 1 

ELSE  ! it  must  be  a Directory  or  message. 

SELECT  Bd$(Choose(l))[1 8,22] 

CASE  "up  ON"  ! move  up  one  directory 
LOOP 

Ms_path$  = Ms_path$[1  ,LEN(Ms_path$)-1  ] 
EXIT  IF  LEN(Ms_path$)  =0 

Test  $ » Ms_path  $ [LEN  (Ms_path  $ ) ; 1 ] 

EXIT  IF  Test$  = "/" 

END  LOOP 

CASE  "ROOT  " ! jump  to  root  directory 
Ms_path$  = "" 

CASE  "DIR  " ! add  directory  to  Ms_path$ 

Test  $ = TRIM  $ (Bd  $ (Choose(l)H  1 , 1 4] ) 

Ms_path$  = Ms_path$&Test$&"/" 

CASE  ELSE 

DISP  "ERROR  in  directory  jump" 

PAUSE 
END  SELECT 
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6822 

6824 

6826 

6828 

6830 

6832 

6834 

6836 

6838 

6840 

6842 


END  IF 

DISP  CHR$(12J 


ELSE 

DISP  " This  directory  contains  no  ";Ftype$;"  files  ... 
WAIT  2.5 
End  search -1 


END  IF 


S = Cent 
END  IF 
NEXT  I 
END  IF 


6844  UNTIL  End  search 

6846  SUBEXIT 

6848  Cat_errors:l 

6850  DISP  " ERROR  ...  ";ERRM$ 

6852  BEEP 

6854  CALL  PauseJ<ey_on 

6856  DISP  CHR$(! 2) 

6858  C_ont-0 

6860  MAT  Fls$  = ("") 

6862  SUBEXIT 

6864  I 

6866  I //////////////////////////////////////////////////// 

6868  S 

6870  Read_data_id:  ! This  routine  expects  to  see  lds$  from 
6872  I GRAPH  DATA  raw  data  files. 

6874  DISP  " Reading  file  contents  ...  Please  stand  by.  B 

6876  PRINT  TABXY{1,18);"  Reading 

6878  FOR  1 = 1 TO  Bd_cnt  ! each  BOAT  file 

6880  PRINT  TABXY(11,18); 

6882  PRINT  USING  "3Dt4At3D,2At#";l,"  of  "fBd_cnt,".  " 

6884  lds$  = "Data  not  recognized." 

6886  IF  Bd$(l)[1 8C22]  = "BOAT  * THEN 

6888  ON  ERROR  GOTO  Not  recognized 

6890  ASSIGN  @lo_path  TO  Bd$(l»[1;14] 

6892  ENTER  @lo_path;Stat$ 

6894  SELECT  Stat$ 

6896  CASE  BNW 

6898  ENTER  @lo_path;lds$ 

6900  CASE  3Y" 

6902  lds$  = "Complete  graph  in  GRAPH_DATA  form." 

6904  END  SELECT 

6906  Not_recognized:ASSIGN  @lo_path  TO  * 

6908  OFF  ERROR 

6910  IF  Dir_ons2  THEN 

6912  GOSUB  lnterpret_1 

6914  IF  Format_error  THEN  GOTO  Other_format 

6916  GOTO  Go  .on 

6918  END  IF 

6920  Other Jformat:! 

6922  Bd$(M23,71]  = " ...  "&lds$ 

6924  END  IF 

6926  Go_on:NEXT  I 

6928  PRINT  TABXYO  ,1 8);RPT$("  ",40); 

6930  DISP  CHR$(12); 

6932  RETURN 
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6934  ! 

6936  ! /////////////////////////////////////////////////// 

6938  ! 

6940  Interpret^ : ! This  is  used  to  interpret  ID  strings. 

6942  Format_error  = 1 

6944  ! identify  this  particular  format 

6946  RETURN 

6948  I 

6950  ! /////////////////////////////////////////////////// 

6952  1 

6954  Listjjirectory:  I This  routine  will  provide  a tabular  listing  of 
6956  1 the  directory  along  with  lds$  if  provided 

6958  I 

6960  DISP  ’ Listing  directory  ...  " 

6962  ON  TIMEOUT  7,10  GOTO  Printerjcaput 

6964  PRINTER  IS  Printer 

6966  PRINT  USING  "//" 

6968  PRINT  T$ 

6970  IF  LEN(Ms  path$)>0  THEN  PRINT  "HFS  Path:  ";Ms_path$ 

6972  PRINT  RPf $("=", 80) 

6974  PRINT  "File  name"; 

6976  IF  Dir  on  THEN 

6978  PRINT  " - TYPE  ...  contents" 

6980  ELSE 

6982  PRINT  " - TYPE" 

6984  END  IF 

6986  PRINT  RPT$("-",80) 

6988  FOR  I = 1 TO  Bd  cnt 

6990  IF  Bd$(l)[1 8,22]  = Ftype$  OR  Bd$(l)[1 8,22]  = "DIR  "THEN 

6992  PRINT  Bd$(l) 

6994  END  IF 

6996  NEXT  I 

6998  PRINT  RPT$("_",80) 

7000  PRINT 

7002  PRINTER  IS  CRT 

7004  OFF  TIMEOUT  7 

7006  RETURN 

7008  Printer_kaput:DISP  " Printer  not  responding  ...  listing  aborted.  " 

7010  BEEP 

7012  WAIT  1.8 

7014  OFF  TIMEOUT  7 

7016  RETURN 

7018  SUBEND 
7020  ! 

7022  I ********************************************************** 
7024  ! 

7026  SUB  Menu_scroll(D$,T$,ltems$(*), INTEGER  ltem_cnttTo_select,Choose(*)) 

7028  Menu_scroll:!  Original:  22  Jun  1987,  Galen  Koepke,  NBS  723.04 
7030  I Revision:  22  Aug  1990,  12:00,  Dennis  Camell 

7032  ! 

7034  I A general  purpose  menu  utility  for  scrolling  items  and 

7036  I selecting  either  a fixed  number  or  a random  number 

7038  I of  items. 

7040  ! for  fixed  : To_select  > 0 

7042  I for  random  : To_select  = -1 

7044  ! The  items  are  arranged  in  screens  of  15  items  each  and 
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7046  ! the  user  may  access  screens  via  softkeys.  There  may  be 

7048  ! up  to  40  screens  or  600  items  to  choose  from. 

7050  ! Maximum  sizes:  D${80],  T$[51b  ltems(#)(70] 

7052  l ltems$(*)  contains  the  item  descriptions 

7054  l ltem_cnt  is  the  number  of  items  in  ltems$(*) 

7056  ! Choose(*)  is  dimensioned  to  the  number  of  required  choices 

7058  ! and  will  be  filled  with  the  item  numbers  chosen* 

7060  I Toselect  is  the  number  of  required  choices. 

7062  I 

7064  OPTION  BASE  1 

7066  PRINTER  IS  CRT 

7068  DEG 

7070  GOSUB  Def_variables 

7072  GOSUB  Define_screens 

7074  GOSUB  Make_selections 

7076  IF  Null  file  THEN  I reset  to  zero 

7078  item  cnt  - 0 

7080  ltems$(1)  = "" 

7082  Toselect-0  ! no  valid  selections 

7084  END  IF 

7086  SUBEXIT 

7088  I 

7090  I //////////////////////////////////////////////////// 

7092  I 

7094  Def_variables:l 

7096  COM  /Interrupts/  INTEGER  Intrprty 

7098  COM  /Bugs/  INTEGER  Bug  1 ,Bug2eBug3, Printer 

7 1 00  COM  /Sy s / Sy s Jd  $ (1  OS 

7102  I 

7104  INTEGER  Sereen_cnt,ltemsjaer_scn(FirstJtem(40bLastJtem(40) 

7 1 06  INTEGER  I, JfKfFirstJine,LastJinetActive_screen,PointerfLast_pt 

7108  INTEGER  local_prtytSkips,Knobcount,Pointeractive(KO,Null_file 

7110  INTEGER  Exit_flag,Temp„Random_select,lndx 

7112  DIM  Marker$[81,Test$[256) 

7114  S 

7116  I initialize  parameters 

7118  I 

7120  Loeal^prty  - lntr_prty 

7122  IF  Local=prty  < 1 THEN  Loeai_prty  - 1 0 

7124  IF  LEN(SysJd$)  = 0 THEN  Sys_id$  = SYSTEM  $("  SYSTEM  ID*) 

7126  IF  Item  cnt  < 1 THEN 

7128  Null_fiie  - 1 

7130  Itemcnt  = 1 

7132  To_select  = 0 

7134  ltems$(1  ) = "***  Empty  ***° 

7136  ELSE 

7138  Null_file-0 

7140  END  IF 

7142  IF  To_select  = -1  THEN 

7144  Random  select  = 1 ! choose  random  number  of  items 

7146  To_select-0  I needed  for  softkeys 

7148  END  IF 

7150  IF  T o select  > Stem  cnt  THEN  T Deselect » Item  cnt 

7152  MAT  Choose  = (999) 

7154  Skips  = 0 

7156  Knobeount  = Q 
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7158  Doneflag  = 0 

7160  Marker$  = " = = = >"&RPT$(CHR$(8),4) 

7162  RETURN 

7164  ! 

7166  ! //////////////////////////////////////////////////// 

7168  ! 

7170  Define_screens:!  Set  up  screens  of  15  items  each. 

7172  ! 

7174  ltems_per_scn  = 1 5 ! Maximum  number  of  displayable  items 

7176  IF  INT (ltem_cnt/ltems_per_scn)  = ltem_cnt/ltems_per_scn  THEN 

7178  Screen_cnt  = INT (ltem_cnt/ltems  per_scn) 

7180  ELSE 

7182  Screen  cnt  = INT(ltem_cnt/ltems_per_scn)  + 1 

7184  END  IF 

7186  J-1 

7 1 88  FOR  I - 1 TO  Screen  cnt  I set  up  each  screen 
7 1 90  Firstjtem(l)  = J 

7192  IF  J + ltems_per_scn-1  < ltem_cnt  THEN 

7 1 94  Lastjtem(l)  = J + ltems_per_scn-1 

7196  J = J + ltems_per_scn 

7198  ELSE 

7200  Last  item(l)  = ltem  cnt 

7202  END  IF  ' 

7204  NEXT  I 

7206  RETURN 

7208  ! 

7210  I /////////////////////////////////////////////////// 

7212  I 

7214  Make_selections:l  MENU  setup  and  use. 

7216  Active_screen  = 1 ! first  screen  is  active 

7218  Firstjine=*2  I first  printed  line  on  screen  - 2 or  greater. 

7220  GOSUB  Write_screen  ! activate  screen  at  Active_screen 

7222  I and  set  First Jine  and  Last  line  for  Pointer 

7224  ! write  Marker  $ to  first  non-selected  line. 

7226  K0  = 0 I Keys  start  at  zero 

7228  Exit  flag  = 0 ! allow  ENTER  key  to  exit  when  selections  filled. 

7230  Keyjoop:  I 

7232  ON  KBD, Local jsrty  GOSUB  Process_kbd 

7234  ON  KNOB  .01  f Local jarty  GOSUB  Move_pointer 

7236  IF  Randorn_select  THEN 

7238  ! set  keys  for  random  selection 

7240  DISP  D$ 

7242  ON  KEY  KO  LABEL  " Select" ,Local_prty  GOSUB  Select_random 

7244  ON  KEY  KO  + 9 LABEL  " Accept"  fLocal_prty  GOTO  Exitjine 

7246  ELSE  I set  key  KO  for  fixed  selection 

7248  IF  Skips  <To_select  THEN 

7250  DISP  D$  ‘ 

7252  IF  To_select>  1 THEN 

7254  Test$  = " Select  "&VAL$(Skips  + 1)&"  of  B&VAL$(To_select) 

7256  ELSE 

7258  Test$  = " Select" 

7260  END  IF 

7262  ON  KEY  KO  LABEL  Test$,LocaLprty  GOSUB  Selectjixed 

7264  ELSE 

7266  IF  To_select>0  THEN 

7268  DISP  " Selection  process  complete  ..." 
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7270  ELSE 

7272  DISP  " Menu  for  information  only  ...  " 

7274  END  IF 

7276  ON  KEY  KO  LABEL  " Accept", Local jarty  GOTO  Exitjine 

7278  END  IF 

7280  END  IF 

7282  IF  Aetive_screen  < Screen  cnt  THEN 

7284  ON  KEY  KO  + 1 LABEL  " Next  Screen"  ,LocaLprty  GOSUB  Nextjscreen 

7286  ELSE 

7288  OFF  KEY  KO  + 1 

7290  END  IF 

7292  IF  Active_screen  > 1 THEN 

7294  ON  KEY  KO  + 2 LABEL  " Last  Screen" , Local j>rty  GOSUB  Last_screen 

7296  ELSE 

7298  OFF  KEY  KO  + 2 

7300  END  IF 

7302  IF  Skips  >0  OR  Randomseiect  THEN 

7304  ON  KEY  KO  + 3 LABEL  " Reset  Select" 5Local_prty  GOSUB  Selectjeset 

7306  ELSE 

7308  OFF  KEY  KO  + 3 

7310  END  IF 

7312  IF  Tojselect>Q  OR  Random  select  THEN 

7314  ON  KEY  KO  + 4 LABEL  * Abort  KfLocaLprty  GOTO  Escape Jine 

7316  ELSE 

7318  OFF  KEY  KO + 4 

7320  END  IF 

7322  IF  Screen_cnt>2  THEN 

7324  ON  KEY  K0  + 6 LABEL  "Jump  to  Screen",  Localjjrty  GOSUB  Jump_to_scn 

7326  ELSE 

7328  OFF  KEY  KO  + 6 

7330  END  IF 

7332  IF  Exitjlag  THEN  Exitjine 

7334  GOTO  Keyjoop 

7336  Escape  Jine:  Skips  = 0 
7338  MAT  Choose-  (0) 

7340  To_select  = 0 

7342  ExitJine:OFF  KEY 
7344  MAT  SORT  Choose!*) 

7346  OFF  KNOB 

7348  OFF  KBD 

7350  OUTPUT  KBD;CHR$(255)&CHR$«75); 

7352  PRINT  CHR$(1 28); 

7354  ! everything  cleared,  now  go  back  to  work. 

7356  RETURN 

7358  I 

7360  I /////////////////////////////////////////////////// 

7362  I 

7364  Next_screen:  ! 

7366  OFF  KBD 

7368  OFF  KNOB 

7370  OFF  KEY 

7372  IF  Active^screen  ~ Screencnt  THEN  RETURN 

7374  Aetive_screen  = Active  screen+1 

7376  GOSUB  Write_screen  ' 

7378  RETURN 

7380  I 
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7382  ! /////////////////////////////////////////////////// 

7384  ! 

7386  Last_screen:  ! 

7388  OFF  KBD 

7390  OFF  KNOB 

7392  OFF  KEY 

7394  IF  Active_screen  = 1 THEN  RETURN 

7396  Active_screen = Active_screen-1 

7398  GOSUB  Write  screen 

7400  RETURN 

7402  ! 

7404  ! ////////////////////////////////////////////////// 

7406  ! 

7408  Jump_to_errors:DISP  " Not  a valid  screen  number  ...  try  again.  " 

7410  BEEP 

7412  WAIT  1.8 

7414  Jump  to  sen:  I 

7416  0>F"iCBD 

7418  OFF  KNOB 

7420  OFF  KEY 

7422  DISP  " ENTER  the  screen  number  desired  (1  to  ";Screen_cnt;")."; 

7424  UNPUT  Test$ 

7426  Test  $=  TRIM  $(Test$) 

7428  IF  LEN(Test$)  =0  THEN  Jump_to_return 

7430  ON  ERROR  GOTO  Jump  to  errors 

7432  Temp  = INT(VAL(Test$))~ 

7434  OFF  ERROR 

7436  IF  Tempd  OR  Temp>Screen_cnt  THEN  Jump_to_errors 

7438  Active_screen=Temp 

7440  GOSUB  Write_screen 

7442  Jump_to  return:  1 

7444  07sPCHR$(12) 

7446  Test$  = "" 

7448  RETURN 

7450  I 

7452  l ////////////////////////////////////////////////// 

7454  ! 

7456  Select  fixed:! 

7458 
7460 
7462 
7464 
7466 
7468 
7470 
7472 
7474 
7476 
7478 
7480 
7482 
7484 
7486 
7488 
7490 
7492 


OFF  KBD 
OFF  KNOB 
OFF  KEY 

IF  NOT  Pointeractive  THEN 

DISP  "NO  additional  selections  for  this  screen." 

BEEP 
WAIT  2 

DISP  CHR$(1 2); 

RETURN 
END  IF 

IF  Skips  = To_select  THEN 
IF  To_select  = 0 THEN 

DISP  "This  menu  is  for  information  only,"; 
DISP  " no  selection  allowed." 

ELSE 

DISP  "All  selections  have  been  filled,"; 

DISP  " 'Select  Reset'  to  repeat." 

END  IF 
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7494  BEEP 

7496  WAIT  2 

7498  DISP  CHR$(12); 

7500  RETURN 

7502  END  IF 

7 504  Skips  = Skips  + 1 

7506  Ghoose(Skips)  - First jtemlAetive^screen)  + Pointer-Firstjine 

7508  PRINT  CHR$(1 29);  I inverse  video 

7510  PRINT  TABXY(10sPointer);ltems$(Choose(Skips)) 

7512  PRINT  CHR$(128S; 

7514  PRINT  TABXY(1f Pointer); 

7516  SELECT  Pointer 

7518  CASE  Firstjine 

7520  GOSUB  Pointjorward 

7522  CASE  Lastjine  " 

7524  GOSUB  Point_backward 

7526  CASE  ELSE 

7528  f move  forward  unless  it  requires  wrapping  to  beginning. 

7530  IF  Skips-1  >0  THEN  I check  for  selected  items. 

7532  I » Pointer-Firstjine 

7534  LOOP 

7536  K~0 

7538  FOR  J - 1 TO  Skips 

7540  IF  First  Jterrn  Active  screen)  + I - Choose(J)  THEN  K-1 

7542  NEXT  J 

7544  EXIT  IF  K = 0 

7546  1=1+1 

7548  IF  I + First Jine  > Last Jine  THEN  K = -1 

7550  EXIT  IF  K =-1 

7552  END  LOOP 

7554  IF  K = 0 THEN 

7556  GOSUB  Point_forward 

7558  ELSE 

7560  GOSUB  Point_backward 

7562  END  IF 

7564  ELSE 

7566  GOSUB  Point_forward 

7568  END  IF 

7570  END  SELECT 

7572  RETURN 

7574  I 

7576  I ////////////////////////////////////////////////// 

7578  ! 

7580  Select_random:f 
7582  OFF  KBD 

7584  OFF  KNOB 

7586  OFF  KEY 

7588  Test$  = "NO” 

7590  IF  NOT  Pointeractive  THEN 

7592  DSSP  "NO  additional  selections  for  this  screen." 

7594  BEEP 

7596  WAIT  2 

7598  DSSP  CHR$(1 2); 

7600  RETURN 

7602  END  SF 

7604  FOR  1 = 1 TO  To  select 
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7606  IF  Choose(l)  = First  Jtem  (Active_screen)  + Pointer-First  Jine  THEN 

7608  lndx  = l 

7610  Test$  = " YES- 

761 2 END  IF 

7614  NEXT  I 

7616  SELECT  Test$ 

7618  CASE  "YES"  I Selected  item  is  tagged  ...  untag 

7620  IF  Pointer  <>  Last  Jtem  (Active_screen)  + 1 AND  Pointer  < >17  THEN 

7622  PRINT  CHR$(128);I  normafvideo 

7624  ELSE 

7626  PRINT  CHR$(132);l  underline  video 

7628  END  IF 

7630  PRINT  TABXY(10,Pointer);ltems$(Choose(lndx)) 

7632  FOR  I = lndx  TO  To_select-1 

7634  Choose(l)  = Choose(l  + 1) 

7636  NEXT  I 

7638  Choose(To_select)  = 999 

7640  To_select=To_select-1 

7642  CASE  "NO"  I Selected  item  is  untagged  ...  tag  it 

7 644  T o_select = T o_select  + 1 

7646  Choose  (Toselect)  = First  jtem(Active_screen)  + Pointer-First  Jine 

7648  IF  Pointer  < > Last Jtem (Active_screen)  + 1 AND  Pointer  < > 1 7 THEN 

7650  PRINT  CHR$(129);I  inverse'video 

7652  ELSE 

7654  PRINT  CHR$(133);i  inverse  video  with  underline 

7656  END  IF 

7658  PRINT  TABXY(10,Pointer);ltems$(Choose(To_select)) 

7660  END  SELECT 

7662  PRINT  CHR${1 28); 

7664  PRINT  TABXY(1  .Pointer); 

7666  RETURN 

7668  I 

7670  ! ////////////////////////////////////////////////// 

7672  l 

7674  Select  reset:  ICIear  Choose  file 

7676  OFF  KBD 

7678  OFF  KNOB 

7680  OFF  KEY 

7682  IF  Random_select  THEN  To_select  = 0 

7684  Skips  = 0 

7686  MAT  Choose  = (999) 

7688  GOSUB  Write_screen 

7690  RETURN 

7692  ! 

7694  ! ///////////////////////////////////////////////// 

7696  ! 

7698  Process  kbd:l  Allow  use  of  arrows  and  enter  key  in  addition  to  soft. 

7700  Test$=KBD$ 

7702  IF  LEN(Test$)  = 1 AND  Test$[1,1]<  >CHR$(32)  THEN 

7704  BEEP  80...  1 

7706  RETURN 

7708  END  IF 

7710  IF  Test$(1 .1]  = CHR$(32)  THEN  GOSUB  Point Jorward 

7712  IF  Test$[1,1]<  >CHR$(255)  THEN  RETURN 

7714  SELECT  Test$(2, 2] 

7716  CASE  CHR${255) 
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7718 

7720 

7722 

7724 

7726 

7728 

7730 

7732 

7734 

7736 

7738 

7740 

7742 

7744 

7746 

7748 

7750 

7752 


GOSUB  Point_backward 
CASE 


CASE  "V\"T" 


GOSUB  Point_forward 
CASE  "A\"W" 


END  IF 
CASE  ELSE 


IF  Random  select  THEN 


GOSUB  Select_random 
ELSE 


BEEP  80.. .1 


IF  Skips  <To_select  THEN 


GOSUB  Select  fixed 
ELSE 

I exit  routine 


Exit  _f  lag  as  1 
END  IF 


! do  nothing 


7754  END  SELECT 

7756  Test$ 

7758  RETURN 

7760  I 

7762  I ////////////////////////////////////////////////// 

7764  S 

7766  PointJorward:Knobcount-5 
7768  GOSUB  Move_pointer 

7770  RETURN 

7772  Point_backward:Knobeount  = -5 
7774  GOSUB  Movejaointer 

7776  RETURN 

7778  t 

7780  ! ////////////////////////////////////////////////// 

7782  I 

7784  Jog  pointer:!  Move  the  selection  pointer  on  the  active  screen. 

7786  ! without  regard  to  selected  values 

7788  IF  Knobcount>0  THEN  ! Move  forward 

7790  Pointer  = Pointer  + 1 

7792  ELSE  S Move  backward 

7794  Pointer  = Pointer- 1 

7796  END  IF 

7798  IF  Pointer  < First Jine  THEN  Pointer  - Last Jine 

7800  IF  Pointer  > Last Jine  THEN  Pointer  - First  Jine 

7802  RETURN 

7804  l 

7806  I ///////////////////////////////////////////////////////// 

7808  I 

7810  Move_pointer:!  Control  pointer  to  avoid  re-selection  of  items 

7812  IF  NOT  Pointeractive  THEN  RETURN  ! No  selections  to  be  made. 

7814  Knobcount  = Knobcount  + KNOBX-KNOBY 

7816  IF  ABS(Knobcount)  < 4 THEN  RETURN 

7818  Last_pt  = Pointer 

7820  GOSUB  Jog_pointer 

7822  IF  Skips >0  THEN 

7824  LOOP 

7826  J = Pointer-First  Jine 

7828  FOR  1-1  TO  Skips 
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7830  IF  First  item(Active  screen)  +J  =Choose(l)  THEN  J = 999 

7832  NEXT  I 

7834  IF  J = 999  AND  Pointer  = Last_pt  THEN  Pointeractive  = 0 

7836  EXIT  IF  Pointeractive  = 0 

7838  IF  J = 999  THEN  GOSUB  Jog_pointer 

7840  EXIT  IF  J<  >999 

7842  END  LOOP 

7844  END  IF 

7846  Knobcount  = 0 

7848  OUTPUT  KBD;CHR$(255)&CHR$(84);  I Bring  screen  home 
7850  IF  Last  pt  = Last_line  THEN  PRINT  CHR$(132); 

7852  PRINT  " 

7854  IF  Pointeractive  THEN  ! Pointer  active 

7856  IF  Pointer  = Lastjine  THEN 

7858  PRINT  CHR$(1 32); 

7860  ELSE 

7862  PRINT  CHR$(1 28); 

7864  END  IF 

7866  PRINT  TABXYH  ,Pointer);Marker$;CHR$(1 28); 

7868  END  IF 

7870  RETURN 

7872  I 

7874  ! ////////////////////////////////////////////////// 

7876  ! 

7878  Write_screen:l  Write  the  screen  pointed  to  by  Active_screen 
7880  I home  and  clear  screen 

7882  OUTPUT  KBD;CHR$(255)&CHR$(84)&CHR$(255)&CHR$(75); 

7884  Knobcount  = KNOBX-KNOBY  I Clear  knob  and  keyboard 
7886  Knobcount  = 0 

7888  Test$  = KBD$ 

7890  Test$  = "" 

7892  l 

7894  PRINT  TABXY(1  ,First_line-1  );CHR$(1 32);"  Item  #|  Screen 

7896  PRINT  USING  "#f2D,4A,2D,3A";Active_screen,"  of  ";Screen  cnt;"  | " 

7898  PRINT  T$;RPT$("  ",51-LEN(T$)); 

7900  PRINT  TABXY(80, First Jine-1 );"  | ";CHR$(1 28); 

7902  J =0 

7904  REPEAT 

7906  IFJ  = Last  item(Active_screen)-First_item(Active_screen)  THEN 

7908  PRINT  CHR$(  132); 

7910  PRINT  TABXYd  ,FirstJine  + J);RPT$("  \80) 

7912  ELSE 

7914  PRINT  CHR$(1 28); 

7916  END  IF 

7918  PRINT  TABXY(5,FirstJine  + J); 

7920  PRINT  USING  "3D,A>#";FirstJtem(Active_screen)  + Jf"  | " 

7922  IF  Random_select  THEN 

7924  FOR  I = 1 TO  To_select 

7926  IF  First_item(Active_screen)  + J = Choose(l)  THEN 

7928  PRINT  CHR$(1 29); 

7930  END  IF 

7932  NEXT  I 

7934  ELSE 

7936  IF  Skips  >0  THEN  I make  this  line  inverse  video 

7938  FOR  I = 1 TO  Skips 

7940  IF  First_item(Active_screen)  + J = Choose(l)  THEN 
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7942  PRINT  CHR$(1 29); 

7944  END  IF 

7946  NEXT  I 

7948  END  IF 

7950  END  IF 

7952  PRINT  TABXYd 0,FirstJine  + J)citems$(FirstJtem(Active_sereen)  * J) 

7954  PRINT  TABXY(80, First Jine  + J);’T; 

7956  J=J  + 1 

7958  UNTIL  J > - (LastJtem(Active_screen)-FirstJtem(Active=_screen)  + 1 ) 
7960  Lastjine  = LastJtem(Active_screen)-FirstJtem(Active_screen) 

7962  Lastjine  = Lastjine  + Firstjine 

7964  ! 

7966  ! set  marker  to  first  non-selected  item. 

7968  ! 

7970  Pointeractive  = 0 

7972  IF  To_select>0  OR  Randomselect  THEN  Pointeractive  = 1 

7974  IF  Skips>0  AND  Pointeractive  - 1 THEN  I find  first  non-selected  item 

7976  J-0 

7978  LOOP 

7980  Pointer  - Firstjine  + J 

7982  FOR  I = 1 TO  Skips 

7984  IF  First Jtem(Aetive_screen)  + J = Choose(t)  THEN  Pointer -0 

7986  NEXT  I 

7988  EXIT  SF  Pointer <>0 

7990  J=J  + 1 

7992  IF  Firstjine  + J > Lastjine  THEN 

7994  Pointeractive  = 0 

7996  Pointer  - First  Jine 

7998  END  IF 

8000  EXIT  IF  Pointer <>0 

8002  END  LOOP 

8004  ELSE 

8006  Pointer  = Firstjine 

8008  END  IF 

8010  IF  Pointeractive  THEN 

8012  IF  Pointer  = Lastjine  THEN 

8014  PRINT  CHR$d  32); 

8016  ELSE 

8018  PRINT  CHR$(1 28); 

8020  END  IF 

8022  PRINT  TABXYd  ,Pointer);Marker$;CHR$d  28); 

8024  END  IF 

8026  RETURN 

8028  SUBEND 
8030  ! 

8032  ! ********  * * * * * * * ********  «*«***«•«  * * * * * * * 

8034  ! 

8036  SUB  Errortrap 
8038  Errortrap:  I Original:  13  Nov  1984 
8040  I Revision:  02  Dec  1987 

8042  I Trap  most  errors  here 

8044  OPTION  BASE  1 

8046  COM  /Files/  Diskdrive$l20]tFilename$[1 4]„Ms  path$[500] 

8048  DIM  File$[20],Test$[256],What$[201,Ac$l5] 

8050  BEEP  400, .6 

8052  SELECT  ERRN 
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8054  CASE  54 

8056  DISP  "DUPLICATE  FILE  NAME:  ";Filename$; 

8058  DISP  "....PURGE  old  one?  (Y/N)"; 

8060  LINPUT  What$ 

8062  What$=TRIM$(What$) 

8064  SELECT  What$[  1,1] 

8066  CASE  "Y","y" 

8068  PURGE  Ms  path$&Filename$&Diskdrive$ 

8070  CASE  ELSE 

8072  Ac$  = "VALID" 

8074  CALL  Enterfilename(Ac$) 

8076  END  SELECT 

8078  CASE  52,53 

8080  DISP  "Improper  FILE  NAME  — ENTER  NEW  FILE  NAME"; 

8082  OUTPUT  2 USING  "#,K,K";"r,Filename$ 

8084  LINPUT  Filename$ 

8086  Filename  $=  TRIM  $ (Filename  $) 

8088  CASE  56 

8090  DISP  "FILE:  ";Filename$;"  is  not  on  this  disk,  please  insert"; 

8092  DISP  " correct  disk" 

8094  CALL  Pause_key_on 

8096  CASE  64 

8098  DISP  "This  disk  is  full,  PLEASE  insert  clean  disk" 

8100  CALL  Pause_key_on 

8102  CASE  56 

8104  DISP  "DATA  INPUT  disk  must  be  in  drivel!  "; 

8106  DISP  "...CONTINUE  when  ready." 

8 1 08  CALL  Pause_key_on 

8110  CASE  72,73,76 

8112  DISP  Diskdrive $; 

8114  DISP  " is  not  available,  type  correct"; 

8116  DISP  " unit  specifier  (ie.  707,0')."; 

8118  OUTPUT  2 USING  "K,#";Diskdrive$ 

8120  LINPUT  Diskdrive  $ 

8122  CASE  80 

8124  DISP  "CHECK  DISK  drive  door!" 

8126  CALL  Pause_key_on 

8128  CASE  ELSE 

8130  DISP  ERRM$;"  'CONTINUE'  when  fixed" 

8132  CALL  Pause_key_on 

8134  END  SELECT 

8136  DISP  CHR$(1 2) 

8138  SUBEXIT 

8140  SUBEND 
8142  ! 

8144  * * 

8146  ! 
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7942  PRINT  CHR$(1 29); 

7944  END  IF 

7946  NEXT  I 

7948  END  IF 

7950  END  IF 

7952  PRINT  TABXY(1 0,FirstJine  + J);ltems$(FirstJtem(Active_sereen)  + J) 

7954  PRINT  TABXY«80, First  line  + J);"|"; 

7956  J = J + 1 

7958  UNTIL  J > - (LastJtem(Active_screen)-FirstJtem(Active_sereen)  + 1 ) 
7960  Lastjine  = LastJtem(Active_screen)-FirstJtem(Active_screen) 

7962  Last  line  = Lastjine  + First  line 

7964  ! 

7966  ! set  marker  to  first  non-selected  item. 

7968  ! 

7970  Pointeractive -0 

7972  IF  To_select>0  OR  Randomselect  THEN  Pointeractive  = 1 

7974  IF  Skips>0  AND  Pointeractive  - 1 THEN  I find  first  non-selected  item 

7976  J = 0 

7978  LOOP 

7980  Pointer  - First  Jine  + J 

7982  FOR  I = 1 TO  Skips 

7984  IF  First  item(Active  screen)  + J -Choose(l)  THEN  Pointer -0 

7986  NEXT  I 

7988  EXIT  IF  Pointer <>0 

7990  J=J  + 1 

7992  IF  First Jine  + J > Last  Jine  THEN 

7994  Pointeractive -Q 

7996  Pointer  = First  Jine 

7998  END  IF 

8000  EXIT  IF  Pointer <>0 

8002  END  LOOP 

8004  ELSE 

8006  Pointer  = First  Jine 

8008  END  IF 

8010  IF  Pointeractive  THEN 

8012  IF  Pointer  s Last  Jine  THEN 

8014  PRINT  CHR$(1 32); 

8016  ELSE 

8018  PRINT  CHR$(1 28); 

8020  END  IF 

8022  PRINT  TABXYO  ,Pointer);Marker$;CHR$(1 28); 

8024  END  IF 

8026  RETURN 

8028  SUBEND 
8030  ! 

8032  ! **************************************** 

8034  ! 

8036  SUB  Errortrap 
8038  Errortrap:  I Original:  13  Nov  1984 
8040  I Revision:  02  Dec  1 987 

8042  I Trap  most  errors  here 

8044  OPTION  BASE  1 

8046  COM  /Files/  Diskdrive$(20]tFilename$n4]5Msrapath$f500) 

8048  DIM  File$[20]fTest$[256LWhat$(20LAc$(5] 

8050  BEEP  400, .6 

8052  SELECT  ERRN 
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8054 

8056 

8058 

8060 

8062 

8064 

8066 

8068 

8070 

8072 

8074 

8076 

8078 

8080 

8082 

8084 

8086 

8088 

8090 

8092 

8094 

8096 

8098 

8100 

8102 

8104 

8106 

8108 

8110 

8112 

8114 

8116 

8118 

8120 

8122 

8124 

8126 

8128 

8130 

8132 

8134 

8136 

8138 

8140 

8142 

8144 

8146 


CASE  54 

DISP  "DUPLICATE  FILE  NAME:  " filename  $; 

DISP  "....PURGE  old  one?  (Y/N)"; 

LINPUT  What$ 

What$=TRIM$(What$) 

SELECT  What$(1,11 
CASE  "Y","y" 

PURGE  Ms  path$&Filename$&Diskdrive$ 

CASE  ELSE 
Ac$  = " VALID- 
CALL  Enterfilename(Ac$) 

END  SELECT 
CASE  52,53 

DISP  "Improper  FILE  NAME  — ENTER  NEW  FILE  NAME"; 
OUTPUT  2 USING  "#,K,K";"#";Filename$ 

LINPUT  Filenames 
Filename  $ = TRIM  $ (Filename  $) 

CASE  56 

DISP  "FILE:  ";Filename$;"  is  not  on  this  disk,  please  insert"; 
DISP  " correct  disk" 

CALL  Pause_key_on 
CASE  64 

DISP  "This  disk  is  full,  PLEASE  insert  clean  disk" 

CALL  Pause  key_on 
CASE  56 

DISP  "DATA  INPUT  disk  must  be  in  drivel!  "; 

DISP  "...CONTINUE  when  ready." 

CALL  Pause_key_on 
CASE  72,73,76 
DISP  Diskdrive $; 

DISP  " is  not  available,  type  correct"; 

DISP  " unit  specifier  (ie.  707,0')."; 

OUTPUT  2 USING  "K,#";Diskdrive$ 

LINPUT  Diskdrive  $ 

CASE  80 

DISP  "CHECK  DISK  drive  door!" 

CALL  Pause_key_on 
CASE  ELSE 

DISP  ERRM$;"  'CONTINUE'  when  fixed" 

CALL  Pause_key_on 
END  SELECT 
DISP  CHR$(1 2) 

SUBEXIT 

SUBEND 


! 
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B.2  DECON  NIST 


100 

102 

104 

106 

108 

110 

112 

114 

116 

118 

120 

122 

124 

126 

128 

130 

132 

134 

136 

138 

140 

142 


! RE-STORE  "DECQN_NIST:,702" 

! 

COM  /Sys/  Sys_id$[10] 

COM  /Sys_msi/  Msijd$[20] 

I 

OUTPUT  KBD  USING  "K,#";"SCRATCH  KEYE"  I ERASE  SOFT  KEYS 
CONTROL  KBD,15;0!  sets  the  color  of  the  soft  keys 
CONTROL  KBD,2;1 
I 

Intrprty  = 1 
CALL  Decon 

! 

CLEAR  SCREEN 

OUTPUT  KBD  USING  "K,#";"lOAD  KEYE"!  restore  the  typing  aid  keys 
PRINT  TABXY(1,5);"END  of  program.  So  long." 


! 


Written  by  S.M.  Chesnut  at  the  National  Institute  of  Standards 
and  Technology. 


144  Datejine:  ! April  10,  1391 

146  r*# * * « * * * c « * * * * * « c * * « « « 

148  I 
1 50  END 
152  I 
154  I 
156  I 

158  SUB  Decon 
160  I 

1 62  OPTION  BASE  1 

1 64  COM  /Interrupts/  INTEGER  Intrprty 

166  COM  /Waveforms/  COMPLEX  Resp(4096), COMPLEX  Wave(4096),COMPLEX  Reg(4096) 
168  COM  /Waveforms/  REAL  Dif_op(4096), COMPLEX  Decn(4096),COMPLEX  Td(4096) 

170  COM  /Data_stuff/  INTEGER  Number, REAL  Delta_x,REAL  Strt_time 
172  COM  /Deconv/  REAL  Gamma, INTEGER  Min  flag 

174  ! 

176  Decon:  ! 

178  S 
180  ! 

182  DIM  Ch $ [ 1 ] , Data jd $ [40] , Set_dc $(11 

184  INTEGER  Itemp, Fig, Extended, Resp_ext,Typ,No_fft 

186  REAL  Rtemp, Sum, Dum,Atten 

1 88  COMPLEX  C_temp 

190  COMPLEX  Sigma, W 

192  I 

1 94  RAD 

196  OFF  KEY 

1 98  CLEAR  SCREEN 

200  Ch$  = 

202  Number  = 32767 

204  Resp_ext  = 0 

206  Extended  =0 

208  Typ  = 0 
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210 

212 

214 

216 

218 

220 

222 

224 

226 

228 

230 

232 

234 

236 

238 

240 

242 

244 

246 

248 

250 

252 

254 

256 

258 

260 

262 

264 

266 

268 

270 

272 

274 

276 

278 

280 

282 

284 

286 

288 

290 

292 

294 

296 

298 

300 

302 

304 

306 

308 

310 

312 

314 

316 

318 

320 

322 

324 


No_fft  = 0 

CALL  Get_data(Wave(#),Dum,Flg) 

Rtemp  = Delta_x 

INPUT  "Nahaman-Gans  extend  the  waveform?  y/n  (default  is  n)",Ch$ 

IF  (Ch$  = "Y")  OR  (Ch$  = "y")  THEN 
Ch$  = "" 

INPUT  "Is  the  waveform  impulse-like?  y/n  (default  is  n)",Ch$ 

IF  (Ch$  = "y")  OR  (Ch$  = "Y")  THEN  Typ  = 1 
CALL  Ng_extend(Wave(#),Typ) 

Extended  = 1 
END  IF 

Itemp  = Number 
Typ  =0 

REDIM  Wave(Number) 

CALL  Get_data(Resp(*),Sum,Flg) 

lnt_resp  = (Sum-.5*  (Respd ) + Resp(Number)))#Delta_x 

INPUT  "Nahaman-Gans  extend  the  waveform?  y/n  (default  is  n)",Ch$ 

IF  (Ch$  ~ "Y")  OR  (Ch$  = "y")  THEN 
Ch$  = 

INPUT  "Is  the  waveform  impulse-like  y/n  (default  is  n)",Ch$ 

IF  (Ch$  = "y")  OR  (Ch$  = "Y")  THEN  Typ  = 1 
CALL  Ng_extend(Resp(#),Typ) 

Resp_ext  = 1 
END  IF  " 

REDIM  Resp(Number) 

! 

Bugl  -0 
IF  Bugl  THEN 

PRINT  Number.ltemp 
PRINT  Delta_x,  Rtemp 
PRINT  "Type  continue  to  go  on." 

PAUSE 
END  IF 
! 

IF  (Itemp  <>  Number)  OR  (DR0UND(Rtemp,3)<  >DR0UND(Delta_x,3))  THEN 
BEEP 

DISP  "The  system  and  the  output  waveforms  are  inconsistent." 

WAIT  1 .0 

DISP  "This  program  is  ended." 

SUBEXIT 
END  IF 
! 

Setdc$  = "y" 

INPUT  "Set  the  dc  level  ? y/n  (default  = y)",Set_dc$ 

! 

Ch$  = "y" 

INPUT  "Do  you  want  iterative  deconvolution?  y/n  (default  = y)",Ch$ 

! 

! 

IF  (Ch$  = "N")  OR  (Ch$  = "n")  THEN 

INPUT  "What  is  the  value  for  gamma?", Gamma 
CALL  Do_fft(Resp(#),1  ,No_fft) 

IF  No_fft  THEN  SUBEXIT  “ 

CALL  Do_fft(Wave(* ),  1 ,No_fft) 

IF  Nojft  THEN  SUBEXIT 

CALL  Gam(Sum,lmag_sum,Set_dc$) 

ELSE 

CALL  Do_fft(Wave( * ),  1 ,No  fft) 
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326 

328 

330 

332 

334 

336 

338 

340 


IF  (Extended)  AND  (NOT  Typ)  THEN 
MAT  Td  = (2)*Td 


END  IF 


CALL  Do_fft(Resp(*),1  ,No_fft) 


IF  Nojft  THEN  SUBEXIT 
CALL  lterate(Sum,Set_dc$) 


IF  No  fft  THEN  SUBEXIT 


342  END  IF 

344  CALL  Record_data (Extended, Sum) 

346  SUBEXIT 

348  SUBEND 
350  I 

352  !*  * * **************** 

354  ! 

356  SUB  Ng  extend  (COMPLEX  Wave(*), INTEGER  Typ) 

358  I 

360  Ng  extend:  I 

362  S This  routine  performs  the  Nahman-Gans  waveform  extension  for  step- 
364  I like  and  square-like  waveforms,  and  "pads"  impulse-like  waveforms 
366  I with  zeros. 

368  ! The  array  'waveform'  is  a complex  data  array  which  contains  the 

370  ! data  to  be  extended. 

372  ! 

374  I Span  is  the  sum  of  the  beginning  and  ending  values  of  the 
376  I waveform. 

378  I 

380  COM  /Data_stuff/  INTEGER  Number,REAL  De!ta_x,REAL  Strt_time 

382  ! 

384  ! 

386  DIM  Ch$[1) 

388  S 

390  IF  Typ  THEN 

392  Try_again:  5 

394  INPUT  "Extend  to  a)  2048  or  b)  4096  points.  Enter  letter„\Ch$ 

396  SELECT  Ch$ 

398  CASE  BaVAB 

400  Ndex -2048 

402  CASE  "bVB* 

404  Ndex  -4096 

406  CASE  ELSE 

408  BEEP 

410  DSSP  "Error  in  selection,  try  again." 

412  WAIT  1.0 

414  GOTO  Try  again 

416  END  SELECT 

418  END  IF 

420  IF  Typ<  > 1 THEN 

422  FOR  I = 1 TO  Number 

424  Ndex  = 1 + Number 

426  Wave(Ndex)  = Wave(Number)  + Wavefl  )-Wave(l) 

428  NEXT  I 

430  Number  = Number6  2 

432  ELSE 

434  FOR  I = Number  + 1 TO  Ndex 

436  Waved)  = CMPLX(O.O) 
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438 

440 

442 

444 

446 

448 

450 

452 

454 

456 

458 

460 

462 

464 

466 

468 

470 

472 

474 
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484 
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492 
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500 
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518 

520 
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524 

526 

528 

530 

532 

534 

536 

538 

540 

542 

544 

546 

548 


NEXT  I 

Number  = Ndex 
END  IF 

I Extension  complete. 

SUBEXIT 

SUBEND 

I 

I 

I 

SUB  lterate(REAL  Sum,Set_dc$) 

! 

Iterate:  I 
l 

I This  routine  sets  up  the  iterative  deconvolution. 

! The  actual  deconvolution  is  performed  in  the  sub  GAMMA. 

! 

OPTION  BASE  1 

COM  /Interrupts/  INTEGER  lntr_prty 

COM  /Waveforms/  COMPLEX  Resp(4096),COMPLEX  Wave(4096), COMPLEX  Reg(4096) 
COM  /Waveforms/  REAL  Dif_op(4096),COMPLEX  Decn(4096),COMPLEX  Td(4096) 

COM  /Data  stuff/  INTEGER  Number, REAL  Delta  x,REAL  Strt_time 
COM  /Deconv/  REAL  Gamma, INTEGER  Min  flag” 

! 

ALLOCATE  Ht_gam(  1000,2) 

REAL  Step, Strt,Stop,Min_sum,Last_min, Inc 
INTEGER  I, J,Min_pos, Done, Exists 
DIM  C$[1],Data  id$[40] 

I 

Done  = 0 
Step  = 1 

INPUT  "What  is  the  starting  attenuation  value?", Strt 
INPUT  "What  is  the  stopping  attenuation  value?", Stop 
J = 1 

MAT  Ht_gam  = (0) 

WHILE  NOT  Done 

REDIM  Ht  gam (1000, 2) 

FOR  Inc  = Strt  TO  Stop  STEP  Step 
Gamma  = 10Alnc 
Exists  = 0 

MAT  SEARCH  Ht_gam(*,1  ),LOC(  = Gamma);Exists 
IF  (Exists  < 1 ) OR  (Exists  >1000)  THEN 
CALL  Gam(Sum,lmag_sum,Set_dc$) 

Ht__gam(J,1 ) - Gamma 
Ht_gam(J,2)  = Imagsum 
J=J  + 1 
END  IF 
NEXT  Inc 

REDIM  Ht_gam(J-1 ,2) 

MAT  SORT  Ht_gam(#,1) 

GOSUB  Find_min 
IF  Step <.50  THEN  Done  = 1 
SELECT  Min_pos 
CASE  =(J-1) 

Strt  = Stop 
Stop  = Strt  + 2 
CASE  =1 
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550  Stop  - Strt 

552  Strt = Stop-2 

554  CASE  ELSE 

556  Strt  = L6T(Ht_gam(Min_posf  1 ))-Step 

558  Stop  = LGT(Ht_gam(Min_pos,1 ))  + Step 

560  Step  = Step/4. 

562  END  SELECT 

564  END  WHILE 

566  Gamma  = Ht_gam(Minjx)S,1 ) 

568  CALL  Gam(Sum,Ht_gam(Min_pos,2),Set_de$) 

570  J=J-1 

572  INPUT  "Save  the  imaginary  sum  vs  gamma  ? y/n",C$ 

574  IF  {C$  * "y")  OR  (C$  - "Y")  THEN 

576  REDIM  Ht_gam(J,2) 

578  MAT  SORT  Htjgam(#f1) 

580  INPUT  "Enter  a 40  character  or  less  data  description.BeDataJd$ 

582  lntr_prty  - Local_prty  + 3 

584  CALL  Data_to_disk_r(Ht_gam(#),J>JcDataJd$) 

586  Intr  prty- Local  prty 

588  END  IF 

590  DEALLOCATE  Ht=gam(#) 

592  SUBEXIT 

594  Find_min:  ! 

596  Bugl  -0 

598  IF  Bugl  THEN 

600  FOR  1 = 1 TO  J-1 

602  PRINT  Ht  gam(LI) 

604  PRINT  Ht  gam(l,2» 

606  NEXT  I 

608  END  IF 

610  Min_sum  = Ht_gam(1,2) 

612  Min_pos  = 1 

614  FOR  1 = 2 TO  J-1 

616  IF  Ht_gam(l,2)<Min_sum  THEN 

618  Min_sum  = Ht_gam(l,2) 

620  Min_pos  = S 

622  END  IF 

624  NEXT  I 

626  RETURN 

628  SUBEND 
630  ! 

632  !*  * * * * **«.*«*.<># 

634  ! 

636  SUB  Gam(REAL  Sumj-esp,lmg_sum,Set_dc$) 

638  I 

640  OPTION  BASE  1 

642  RAD 

644  COM  /Interrupts/  INTEGER  lnrt_prty 

646  COM  /Waveforms/  COMPLEX  RespC ), COMPLEX  Waver  ^COMPLEX  RegD 

648  COM  /Waveforms/  REAL  Dif_op(#  ^COMPLEX  Decn(*), COMPLEX  TdH 
650  COM  /Data_stuff/  INTEGER  Number, REAL  Deltajc,REAL  Strt_time 

652  COM  /Deconv/  REAL  Gamma, INTEGER  Min_flag 

654  I 

656  ! This  subroutine  generates  the  regularization  filter  and  the 

658  I calculations  for  deconvolution. 

660  ! NIST,  Boulder,  Colorado. 
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662  ! 

664  INTEGER  J.NoJft 

666  COMPLEX  Decn_val,Ctemp 

668  I 

670  I Initialize  the  variables. 

672  ! 

674  Gam:  I 

676  DISP  "Performing  the  deconvolution." 

678  lmag_sum  = 0. 

680  REDIM  Td(Number) 

682  MATDecn  = Resp 

684  IF  (Set  dc$  = "y")  OR  (Set_dc$  = "Y")  THEN 
686  Decn(1 ) = CMPLX(ABS(Resp(2)),0.) 

688  ELSE 

690  IF  Decn(1)=CMPLX(0.,0.)  THEN  Decn(1)  = CMPLX(Sum_resp,0.) 

692  END  IF 

694  Decn(1)= Waved  )/Decn(1) 

696  IF  NOT  Min  flag  THEN  Reg(1 ) = CMPLX(0.,0.) 

698  FOR  J = 2 TO  Number 

700  IF  Decn(J)  =CMPLX(0.,0.)  THEN 

702  Decn(J)  = Ctemp 

704  IF  NOT  Min  flag  THEN  Regd ) = CMPLX(0.,0.) 

706  END  IF 

708  IF  NOT  Min  flag  THEN 

7 1 0 Magn  = REAL(Resp(J)r2  + IMAG(Resp(J)r2 

7 1 2 Rtemp  = 2.  * PI  * (J=1  )/(Number-1 .) * 1 . 

7 1 4 Dif_opr  = 6.0-8.0*  COS(Rtemp)  + 2.  * COS{2. # Rtemp) 

716  Reg(J)  = Magn/(Magn  + Gamma  * Dif_opr) 

718  END  IF 

720  Ctemp  = Resp(J) 

722  Decn(J)  = Wave(J)*  Reg(J)/Resp(J) 

724  NEXT  J 

726  MAT  Td=  Decn 

728  Do_fft(Td(*),-1  ,No_fft)  (CONVERT  TO  TIME  DOMAIN 

730  lmg_sum  = 0 

732  FOR” I = 1 TO  Number 

734  Img  sum  = IMAG(Td(l))A2  + lmg_sum 

736  NEXT  f 

738  lmg_sum  = SQRT(lmg_sum/Number) 

740  PRINT  "gamma  = ",Gammaf"  Imaginary  sum  - ",lmg  sum 
742  PRINTER  IS  CRT  . 

744  MAT  Td  = (1  /(Delta  x9Number))6Td 

746  SUBEXIT 

748  SUBEND 
750  ! 

752  * ♦**•*.* 

754  I 

756  SUB  Do  fft(COMPLEX  Fft_file(#), INTEGER  Fft_flg,No  fft) 

758  I 

760  OPTION  BASE  1 

762  COM  /Interrupts/  INTEGER  lntr_prty 

764  !FFTJ=IX 

766  INTEGER  12 

768  I 

770  Do_fft:  1 

772  ! 
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774 

776 

778 

780 

782 

784 

786 

788 

790 

792 

794 

796 

798 

800 

802 

804 

806 

808 

810 

812 

814 

816 

818 

820 

822 

824 

826 

828 

830 

832 

834 

836 

838 

840 

842 

844 

846 

848 

850 

852 

854 

856 

858 

860 

862 

864 

866 

868 

870 

872 

874 

876 

878 

880 

882 

884 


12  = 0 

DISP  " Calculating  an  FFT  ...  please  wait  " 

Timer = TIMED  ATE 

Intrprty  = Local_prty  + 3 

CALL  FftJix(Fft_file(*U2,FftJlg) 

Intrprty  = Local  jarty 

! Fft  file(*)  returns  with  results,  12  is  an  error  flag. 

IF  I2<>0  THEN 
SELECT  12 
CASE  1 

DISP  " Negative  data  count,  FFT  aborted." 

WAIT  1 
CASE  2 

DISP  " Data  has  zero  or  negative  spacing,  FFT  aborted." 
WAIT  1 
CASE  3 

DISP  " Data  count  not  a power  of  2,  FFT  aborted." 

WAIT  1 
CASE  ELSE 

DISP  " ERRORS  in  FFT,  operation  aborted." 

END  SELECT 
DISP  "continue  ..." 

PAUSE 

GOTO  No_fft_action 
ELSE 

SUBEXIT 
END  IF 

LOOP  I This  keeps  the  last  disp  (before  the  case  stmt.)  on  screen 
EXIT  IF  TIMED  ATE-Timer>  1 .8 
END  LOOP 
! 

NoJftjJCtion:QFF  KEY 

I 

DISP  "Due  to  a previously  described  error  or  another  strange  event, 
DISP  "no  FFT  was  performed." 

Nofft  = 1 
SUBEXIT 
SUBEND 


SUB  Fftjix (COMPLEX  Fft  Jilen, INTEGER  Err, INTEGER  Fft_flg) 
Fft_fix:  I Original:  04  Jul  1987,  J.  Ladbury 

! Revision:  02  Dec  1987 
I Modifications:  24  Aug  90  S.M,  Chesnut 
! As  modified,  this  routine;  checks  for  valid  data  and 
! splits  the  input  array  (Fft_file)  into  its  real  and  imaginary 
! parts  in  preparation  for  the  Fast  Fourier  Transform  (FFT). 

I After  the  FFT  has  been  performed,  the  real  and  imaginary 
! results  are  stored  in  the  Fft_file  array. 

OPTION  BASE  1 

COM  /Interrupts/  INTEGER  lntr_prty 

COM  /Data_stuff/  INTEGER  Number, REAL  Delta_x,REAL  Strt_time 

I 

! 

INTEGER  Local_prty, Power 
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886  REAL  Fstep 

888  ! 

890  Local  prty  = lntr_prty 

892  Err  = 0 

894  IF  Number  <2  THEN  ! gotta  have  more  than  one  point. 

896  Err  = 1 

898  SUBEXIT 

900  END  IF 

902  IF  (Delta_x<  =0)  THEN  I Check  for  positive  time. 

904  Err  = 2 

906  SUBEXIT 

908  END  IF 

910  Fstep  = 1/(Delta_x#  (Number)) 

912  Power  = LOG(Number)/LOG(2) 

914  IF  INT((2APower) + .5)  <>  Number  THEN  ! FFT  on  data  which  has 
916  I power  of  2 data  points. 

918  Err  = 3 

920  SUBEXIT 

922  END  IF 

924  ALLOCATE  REAL  Re(Number),lm(Number) 

926  MAT  Re  = REAL(Fft_file) 

928  MAT  lm  = IMAG(FftJile) 

930  Intrjarty  - Localprty  + 3 

932  Power  = Power  + 1 

934  CALL  Fftjmag  (Number*  1 ., Power*  1 .0,Fft_flg*  1 .0,Re(*),lm(*)) 

936  lntr_prty  = Local_prty 

938  MAT  Fft  file  = CMPLX(Re,lm) 

940  Bugl  =0"* 

942  IF  Bugl  THEN 

944  FOR  I = 1 TO  Number 

946  PRINT  Fft_file(l);l 

948  NEXT  I 

950  END  IF 

952  DEALLOCATE  Re(*),lm(*) 

954  SUBEND 
956  ! 

960  ! 

962  SUB  Fftjmag(N,Power,Flg,R_{  *),!_(*)) 

964  ! Algorithm  from  HP  library  of  math  routines. 

966  I Modified  25  October  1 990  to  work  on  complex  data. 

968  ! Modification  by  J.  Ladbury  of  NIST,  Boulder,  Colorado. 

970  OPTION  BASE  1 

972  RAD 

974  Baddta  = (N < =0)  OR  (Fig < > 1 ) AND  (Fig < >-1 ) OR  (Power < =0) 

976  IF  Baddta  = 0 THEN  986 

978  PRINT  FNLin$(2);"ERROR  IN  SUBPROGRAM  Fft." 

980  PRINT  "N  = ";N,"Flg  = ";Flg, "Power  = ";Power;FNLin$(2) 

982  CALL  Pause  key_on 

984  GOTO  974 

986  Fft:  K = 0 
988  FOR  J = 1 TON-1 

990  1-2 

992  IF  K<N/I  THEN  1000 

994  K-K-N/l 

996  1=1+1 
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998  GOTO  992 

1000  K = K + N/l 

1002  IF  K < = J THEN  1016 

1004  A = R_(  J + 1 ) 

1006  R_(J  + 1 ) = R_(K  + 1 ) 

1008  RJK+1»=A 

1010  A ~ i (J  + 1) 

1012  I JJ  + 1 ) = l_(K  + 1 ) 

1014  I (K  + 1 } = A 

1016  NEXT  J 

1018  G - .5 

1020  P=1 

1022  FOR  1 = 1 TO  Power- 1 

1024  G=G  + G 

1026  C = 1 

1028  E = 0 

1030  Q = SQR((1  -P)/2S  * Fig 

1032  P = (1-2*(i  = 1»PSQR((1  +P)/2) 

1034  FOR  R = 1 TO  G 

1036  FOR  J = R TO  N STEP  G + G 

1038  K - J + G 

1040  A = C*R  (K)  + E#l  (K) 

1042  B = EsRJK)-CeMK) 

1044  RJK)  = RJJ)“A 

1046  I (K)=IJJ)  + B 

1048  RJJ)  = RJJ)+A 

1050  I «J)=I  (JhB 

1052  NEXT  J 

1054  A-E®P  + G®Q 

1056  C = C*P-E*Q 

1058  E --  A 

1060  NEXT  R 

1062  NEXTS 

1064  SUBEXIT 

1066  SUBEND 
1068  ! 

1 070  t®®®®®*®®®®®®*®*®*®*®®*®®®®®®**®**®*®®*®*®®®®®®*®®®*®4 
1072  ! 

1074  SUB  Con jo  jeal (COMPLEX  Dat(*),REAL  Temp jn, INTEGER  Fig) 

1076  I 

1078  OPTION  BASE  1 

1 080  ! This  subroutine  converts  data  from  COMPLEX  to  REAL  and  converts  to 
1082  ! the  "GRAPHJDATA"  format. 

1084  ! 

1 086  ! DatO  is  the  array  which  contains  the  complex  data. 

1088  ! Temp_f()  is  the  array  which  contains  the  converted  data. 

1090  I Fig  indicates  which  part,  the  real  (fig  = 0)  or  imaginary  (fig  = 1) 

1092  I is  being  saved. 

1094  I Total  is  the  relative  time  of  each  point. 

1096  ! 

1098  Con_to_real"  I 

1100  COM  /Data_stuff/  INTEGER  Number,REAL  Delta_x(REAL  Strtjime 

1102  ! 

1 1 04  REAL  Total 

1106  ! 

1 108  Total  = Delta  x 
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1110 

1112 

1114 

1116 

1118 

1120 

1122 

1124 

1126 

1128 

1130 

1132 

1134 

1136 

1138 

1140 

1142 

1144 

1146 

1148 

1150 

1152 

1154 

1156 

1158 

1160 

1162 

1164 

1166 

1168 

1170 

1172 

1174 

1176 


FOR  I = 1 TO  Number 
IF  NOT  Fig  THEN 

Temp  f(l,2)  = REAL(Dat(l)) 

ELSE 

Temp  f(l,2)  = IMAG(Dat(l)) 

END  IF 

Temp_f(l,1)=Total 
Total  * Total  + Delta_x 
IF  Bug 2 THEN 

PRINT  Temp_f(l,1),Temp  f(l,2) 

PRINT  I 
END  IF 
NEXT  I 
SUBEXIT 
SUBEND 

SUB  Get_data(COMPLEX  File(#),REAL  Total, INTEGER  Fig) 

! This  converts  data  from  x,y  pair  real  data  format  to 
! complex  format.  The  first  position  of  the  data  array  contains 
! the  number  of  data  points  in  the  real  part  and  the  imaginary  part 
I contains  the  point  spacing  (delta  t). 

I FLG  indicates  a real  (fig = 0)  data  file,  (fig  = 1 ) indicates  a 
I complex  data  file. 

! All  files  are  assumed  to  be  x,y  pairs  by  the  routine  load_disk_data. 

! As  such,  it  is  necessary  to  convert  every  file  to  type  COMPLEX. 

OPTION  BASE  1 

COM  /Interrupts/  INTEGER  lntr_prty 

COM  /Files/  Diskdrive$(20],Filename$[14],Ms_path$[500] 

COM  /Data_stuff/  INTEGER  Number, REAL  Delta_x,REAL  Strt_time 


1178  Get  data:  ! 

1180  ~ 1 

1182  REAL  Temp(4096,2) 

1184  INTEGER  Realtor  cmplx 

1186  DIM  Dataid$[40]~ 

1188  Total  = 0 


1 1 90  Read_again:  I 

1192  Diskdrive$  -”B 

1194  Filename  $ -■ 

1 196  DISP  "Enter  the  name  of  the  measured  waveform  when  prompted." 
1198  WAIT  .8 

1200  INPUT  "Is  this  data  real  = 0 or  complex  = 1",Flg 

1 202  IF  (Fig  < > 0)  AND  (Fig  < > 1 ) THEN 

1204  DISP  "IMPROPER  INPUT,  please  try  again." 

1 206  WAIT  1.0 

1 208  GOTO  Read_again 

1210  END  IF 

1212  Real_or_cmplx  = Fig 

1214  lntr_prty  = Local_prty  + 3 

1216  CALL  Load_disk_data(Temp(* ), Number, Dataid$, Fig) 

1218  lntr_prty  = Local_prty-3 

1220  IF  Fig  THEN 
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1 222  BEEP 

1224  DISP  "No  data  was  read.  Please  try  again." 

1 226  WAIT  1 .0 

1228  GOTO  Read_again 

1230  END  IF 

1232  lntr_prty  - Local_prty 

1 234  IF  Real_or_cmplx  = 0 THEN 

1236  FOR  1 = 1 TO  Number 

1 238  Filed)  = CMPLX(Temp(l,2),0.) 

1240  Total -Total  + Temp(l,2) 

1 242  NEXT  I 

1 244  ELSE 

1 246  FOR  I = 1 TO  Number 

1 248  Filed)  -CMPLX(Temp(l,1  KTempd»2)) 

1250  Total  =Total  + ABS(Filed)) 

1252  NEXT! 

1254  END  IF 

1 256  Fig  - Real_or_cmplx 

1 258  SUBEXIT 

1 260  SUBEND 

1262  I 

1266  ! 

1268  SUB  Record  datadNTEGER  Extended, REAL  Sum) 

1270  ! 

1272  Record jJata:  S 

1 274  OPTION  BASE  1 

1276  COM  /Interrupts/  INTEGER  lnrt_prty 

1278  COM  /Waveforms/  COMPLEX  Resp(#), COMPLEX  WaveD,Regn 

1280  COM  /Waveforms/  REAL  Dif_opC), COMPLEX  Decn<* LCOMPLEX  Td(*) 

1282  COM  /Data^stuff/  INTEGER  Number, REAL  Delta_x,REAl  Strt  time 
1284  I 

1286  DIM  Data_id$[40!,C$m 

1288  COMPLEX  Temp_comp(4096) 

1290  INTEGER  Local_prty„Num_o_pnts 

1 292  REAL  Time_scale,Freq  scale 

1294  I 

1 296  Loca!_prty  = Intrprty 

1298  C$  = "n" 

1 300  Num_o_pnts  = Number 

1 302  IF  Extended  THEN 

1304  INPUT  "Record  the  extended  waveforms  ? (default  is  no)",C$ 

1306  IF  !C$<  >"y")  AND  (C$<  >"Y")  THEN 

1 308  Num  o_pnts  = Number/2 

1310  END  IF 

1312  END  IF 

1314  ! 

1316  ALLOCATE  Temp  fi!e(4096,2) 

1318  ! 

1 320  Time_scale  = Delta_x 

1 322  Freq_scale  = 1 ./(Delta=x  * Number) 

1324  ! 

1326  C$  - "n" 

1328  INPUT  "Save  the  spectrum  magnitude  of  the  deconvolved  waveform  ? y/n",C$ 
1 330  IF  (C$  = "y")  OR  (C$  = "Y")  THEN 

1332  INPUT  "Enter  a 40  character  or  less  data  description.", Data_id$ 
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1334 

1336 

1338 

1340 

1342 

1344 

1346 

1348 

1350 

1352 

1354 

1356 

1358 

1360 

1362 

1364 

1366 

1368 

1370 

1372 

1374 

1376 

1378 

1380 

1382 

1384 

1386 

1388 

1390 

1392 

1394 

1396 

1398 

1400 

1402 

1404 

1406 

1408 

1410 

1412 

1414 

1416 

1418 

1420 

1422 

1424 

1426 

1428 

1430 

1432 

1434 

1436 

1438 

1440 

1442 

1444 


lntr_prty  = Local_prty  + 3 
MAT  Temp_comp=  Decn 
REDIM  Temp_comp(4096) 

Temp  = Number 
Delta_x  = Freq_scale 
FOR  I = 2 TO  Num_o_pnts 

IF  ABSfTemp  comp(l))<>0  THEN 

Temp  r = 2#ABS(1.E+12#Temp  comp(l)) 

T emp~r  = 20  * LGT(Temp_r)  I 1 El  2 IS  THE  CONVERSION 

! TO  MICROVOLTS/MHz 
Last_non  zero  = Tern p_r 
ELSE 

Temp  r = Last  non_zero 
END  IF 

Temp_file(l-1 ,1 ) = Delta_x 
Temp_file(l-1 ,2)  =Temp_r 
Delta  _x  = Freq_scale  + Delta_x 
NEXT  I 

CALL  Data_to_disk_r(Temp_file(#),Num_o_pnts-1  ,Num_o_pnts-1  ,Data_id$) 
Intr  prty  = Local  prty 
REDIM  Temp_file(Number,2) 

END  IF 
I 

C$  = "n" 

! INPUT  "Save  the  FFT  of  the  response  the  waveform  ? y/n",C$ 

IF  (C$  = "y")  OR  (C$  = "Y")  THEN 

INPUT  "Enter  a 40  character  or  less  data  description.", Data_id$ 

lntr_prty  --  Local  _prty  + 3 

Delta_x  = Freq_scale 

MAT  Temp_comp=  (1  ./Number)  *Resp 

CALL  Con_to_real(Temp  comp(#),Temp_file(#),0) 

IF  Extended  THEN 

REDIM  Temp_file(Num_o_pnts,2) 

END  IF 

CALL  Data_to_disk_r(T emp_file( * ), Num_o_pnts,Num_o_pnts,Data Jd $ ) 
lntr_prty  = Local_prty 
REDIM  Temp_file(Numberp2) 

END  IF 


C$  = "n" 

INPUT  "Save  the  real  part  of  the  deconvolution  result  ? y/n",C$ 

IF  (C$  = "y")  OR  (C$  = "Y")  THEN 

INPUT  "Enter  a 40  character  or  less  data  description.", Data Jd$ 

Intr  jDrty  = Local_prty  + 3 

Delta_x  =Time_scale 

CALL  Con_to_real(Td(#),Temp_file(#),0) 

IF  Extended  THEN 

REDIM  Temp_file(Num_o_pnts,2) 

END  IF 

CALL  Data_to_disk_r(Temp_file(*),Num_o_pnts,Num_o_pnts,Data_id$) 
Intrprty  = Local_prty 
REDIM  Temp_file(Number,2) 

END  IF 
I 

C$  = "n" 

INPUT  "Save  the  imaginary  part  of  the  deconvolution  result  ? y/n",C$ 
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1 446  IF  (C$  = "y")  OR  (C$  = "Y")  THEN 

1448  INPUT  "Enter  a 40  character  or  less  data  description.”, Data  Jd$ 

1 450  lntr_prty  = Local_prty  + 3 

1452  CALL  Con_to_real(Td( * ),T emp_f  ile(*  ),  1 ) 

1454  IF  Extended  THEN 

1456  REDIM  Temp_file(Num_o_pnts,2) 

1458  END  IF 

1 460  CALL  Data_to_disk_r(Temp_file(*hNum  o_pnts»Num  Qj3nts,DataJd$! 

1 462  lntr_prty  = Local_prty 

1464  REDIM  Temp_file(Number,2) 

1466  END  IF 

1468  ! 

1470  DEALLOCATE  Temp  file(*) 

1472  SUBEXIT 

1474  SUBEND 

1476  I 

1478  I******* ***** *.#...•.«•#**.*«.#*#****♦*##** 

1480  ! 

1482  SUB  Load_disk_data(Basket_file{*), INTEGER  Basketsize,DataJd$, INTEGER  Fig) 

1 484  Load_disk__data:  ! Original:  1 3 Nov  1 984 

1486  ! Revision:  02  Dec  1987 

1 488  SThis  routine  will  enter  data  files  from  the  disk 

1490  OPTION  BASE  1 

1492  f 

1494  COM  /Sys/  Sys _id$ 

1496  COM  /History/  Status$(1  ],Time_orgn$[8],Date_orgn$n  1) 

1498  COM  /History/  Time_chng$[8],Date_chng$[1 1 ],Description$[1 601 

1500  ! 

1502  COM  /Labels/  Labels$(30)[60], INTEGER  Lbl_count,REAL  Lbljjddr(30,6) 

1504  !Lbl_addr:  x,  y,  pen,  size,  LDIR,  LORG 
1506  S 

1508  COM  /Datajaaram/  INTEGER  Datacount,Filesize,Curvecount,Roster(1 7,4) 

1510  COM  /Data_param/  REAL  Sym_size,Symbol$(17)(2],Curve_id$(1 7)[40] 

1512  COM  /Datajaaram/  REAL  Xmin_data,Xmax_data 

1514  COM  /Data_param/  REAL  Ymin_data,Ymax_data 

1516  ! 

1518  IRoster:  Curve#,  Start  Addr  in  Filer),  Datacount,  and  PEN 

1520  !Symbol$(i)~B"  or  "Y"  = > no  symbol,  connect  pts 

1522  !Symbol$(i)  = "*Y"  =>  * symbol,  connect  pts 

1524  !Symbol$(i)“"*N"  =>  * symbol,  do  not  connect  pts 

1526  ! • 

1528  COM  /Background/  Graphtype$[12],Margins$/2)[10],Papersize$ni 

1530  COM  /Background/  REAL  Pen_speed, INTEGER  Backgnd_pen,Auto_time 

1 532  COM  /Background/  INTEGER  Auto_file,REAL  X_cross_y,Y_cross_x 

1534  COM  /Background/  Xgrid_tick$(4), INTEGER  Xmajor,Xminor 

1536  COM  /Background/  Ygrid_tick$(4], INTEGER  Ymajor.Yminor 

1 538  COM  /Background/  REAL  Xmin_graph,Xmax_graph,Ymin_graph,Ymax_graph 

1 540  I 

1542  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

1 544  COM  /Interrupts/  INTEGER  Intr  prty 

1546  COM  /Enlarge Jile/  INTEGER  Overflow 

1548  COM  /Files/  Diskdrive$[201,Filename$|14j,Ms_path$[500] 

1 550  COM  /Data_stuff/  INTEGER  Number, REAL  Delta_x,REAL  Strt_time 
1552  ! 

1 554  INTEGER  R,Hold_size,Local_prty, Allocated, Fls_cnt 

1556  DIM  Ac$(5],Tempfile$[1 0],Mask$[1 0],Ftype$(5],Fls$(1  )(1 4] 
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1 558  REAL  Dtime 

1560  OFF  KEY 

1562  Local_prty  = Intr  prty 

1564  ! 

1566  ISelect  the  disk  drive  where  the  data  exists 
1568  ! 

1 570  IF  Overflow  < > 0 THEN  Overflow  = 0 
1572  Hold_size  = 0 

1574  Dtime =0. 

1576  Allocated  =0 

1578  Selectdrive:  I 

1 580  IF  Diskdrive$  = "NO  DISK"  THEN  Diskdrive$  = "" 

1582  IF  LEN(Diskdrive$)>0  THEN  GOTO  Choosefilename 

1 584  GRAPHICS  OFF 

1586  OUTPUT  2 USING  "#,K";"K" 

1588  CALL  Select  disk 

1590  IF  Diskdrive$"="NO  DISK"  THEN  GOTO  Mistakelineset 
1 592  Choosefilename:  ! 

1594  Tempfile$  = Filename$ 

1596  IF  LEN (Filename $ ) > 0 THEN  GOTO  Bring  in  data 

1598  Ac$  = "CAT- 

1600  CALL  Enterfilename(Ac$) 

1602  IF  LEN(Filename$)  = 0 OR  POS(Filename$,"*")>  1 THEN 
1604  IF  POS(Filename$,"  * ")  > 1 THEN  ! set  mask$ 

1606  Mask$  =Filename$[1  ,POS(Filename$,"#")-1] 

1608  Filename$  = "" 

1610  ELSE 

1612  Mask$  = ""l  no  preselection 

1614  END  IF 

1616  Ftype$  = "BDAT  " ! examine  BDAT  files  only 

1618  Fls_cnt  = 1 1 select  one  file 

1 620  lntr_prty  = Local  prty  + 1 

1622  CALL  File jnenulMask$,Ftype$,Fls$(UFIs_cnt, 0,0) 

1 624  lntr_prty  = Local_prty 

1626  Filename$  =Fls$"(1 ) 

1628  IF  LEN(Filename$)  =0  THEN  ! aborted 

1630  Filename$  =Tempfile$ 

1632  GOTO  Mistakelineset 

1634  END  IF 

1636  END  IF 

1 638  Bring_in_data:  ! 

1640  I 

1 642  IFind  this  file  on  the  disk. 

1644  I 

1 646  ON  ERROR  GOTO  Cantjindfile 

1648  ASSIGN  (©Datapath  TO  Filename$&Diskdrive$ 

1 650  OFF  ERROR 

1652  Dtime  =T1MEDATE 

1654  DISP  " LOADING  disk  file:  ";Filename$;"  ...  "; 

1 656  ON  ERROR  GOTO  Bad  Jile 

1658  ENTER  @Datapath;Status$ 

1660  OFF  ERROR 

1 662  ON  ERROR  GOTO  Cantjindfile 

1664  SELECT  Status$ 

1666  CASE  "Y"  I All  graphics/data  parameters  exist.REN  100,2 
1668  DISP  " Complete  graph.  " 
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1670  ENTER  @Datapath;Time_orgn$,Date_orgn$ 

1672  ENTER  @Datapath;Time_chng$,Date_chng$ 

1674  ENTER  @Datapath;Description$ 

1676  ENTER  @Datapath;Labels$(*),Lbl_count,Lbl_addr(#) 

1678  ENTER  @Datapath;CurveJd$(*),Symbol$(*) 

1680  ENTER  @Datapath;Roster(*),Curvecount 

1682  ENTER  @Datapath;Graphtype$,Margins$(*) 

1684  ENTER  @Datapath;X_cross_y,Yj;ross_x 

1686  ENTER  @Datapath;Xgrid_tick$,Xmajor,Xminor 

1 688  ENTER  @Datapath;Ygrid_tick$,YmajorfYminor 

1 690  ENTER  @Datapath;Xmin_graph,Xmax_graph 

1 692  ENTER  @Datapath;Ymin_graph,Ymax_graph 

1694  CASE  "N"  ! Only  data  parameters  exist. 

1696  DISP  " RAW  data.  " 

1698  CASE  ELSE 

1700  Badjile:  DISP  CHR$«12) 

1702  DISP  "Data  file  is  not  recognized,  entry  aborted."; 

1704  DISP  " ...continue." 

1 706  BEEP 

1708  PAUSE 

1710  OFF  ERROR 

1712  GOTO  Mistakelineset 

1714  END  SELECT 

1716  I 

1718  ENTER  @Datapath;Data_id$ 

1720  IF  Fig  THEN 

1722  ENTER  @Datapath;Deltajc 

1724  ENTER  @Patapath;Datacount 

1726  Hold_size  = Datacount 

1728  ELSE 

1730  ENTER  @Datapath;Datacount 

1732  ENTER  @Datapath;Hold_size 

1734  END  IF 

1 736  IF  NOT  Allocated  THEN 

1738  IF  Datacount > - 1 AND  Hold_size>  *1  THEN 

1 740  ALLOCATE  Holding  Jile(Hold_size, 2) 

1742  ELSE 

1744  ALLOCATE  Holding _file(1  ,2) 

1746  END  IF 

1748  Allocated -1 

1750  END  IF 

1752  ENTER  @Datapath;Holding_file{*) 

1754  ASSIGN  @Datapath  TO  * " 

1756  OFF  ERROR 

1758  IF  NOT  Fig  THEN 

1 760  Delta_x  = Holding_file(2, 1 )-Holding  JileO  ,1 ) 

1762  Strt_time  = Holding  file(1,1) 

1764  END  IF 

1766  IF  Datacount  = 0 THEN  Mistakeline 

1768  I 

1770  ICopy  data  from  Holding_file(*)  to  Basket^filet®) 

1772  I 

1 774  MAT  Basket Jile  = (0.) 

1776  IF  Datacount >Basketsize  THEN  (Receiving  file  too  small. 

1778  Allocated  = 0 

1780  DEALLOCATE  HoldingJileH 


1782  DISP  " DATA  FILE  overflow,  new  data  discarded. 

1784  DISP  " (continue)  " 

1786  BEEP 

1 788  PAUSE 

1 790  IF  Status  $ = "Y"  THEN 

1792  Curvecount  = 0 

1794  MAT  Roster=  (0) 

1796  END  IF 

1798  Overflow  = Hold_size 

1 800  GOTO  Mistakelineset 

1802  END  IF 

1 804  Copydatafile:  I 

1 806  FOR  R = 1 TO  Datacount 

1 808  BasketJ  ile(R,  1 ) = HoldingJ  ile(R,  1 ) 

1810  Basket_file(R,2)  = Holding_f  ile(R,2) 

1812  NEXT  R 

1814  Basketsize  = Datacount 

1816  Fig  =0 

1818  GOTO  Mistakeline 

1820  I 

1822  Mistakelineset:Datacount=0 
1824  Fig  = 1 

1 826  Mistakeline:OFF  KEY 

1828  IF  Allocated  THEN  DEALLOCATE  HoldingJileD 

1 830  LOOP 

1 832  EXIT  IF  TIMEDATE-Dtime  > 1 .8 

1834  END  LOOP 

1836  DISP  CHR$(1 2) 

1838  OUTPUT  2 USING 

1840  SUBEXIT 

1842  ! 

1 844  ! //////////////////////////////////////////////////////// 

1846  ! 

1 848  Cant_findfile:  lError  in  searching  for  the  file. 

1 850  BEEP  500, .6 

1 852  SELECT  ERRN 

1854  CASE  56 

1856  DISP  "That  file  does  not  exist  on  this  disk 

1858  CASE  72,73,76,82 

1860  DISP  Diskdrive$;”  has  failed  or  is  not  available 

1 862  CASE  ELSE 

1864  DISP  ERRM$; 

1866  END  SELECT 

1868  DISP  " ....CONTINUE  to  try  again." 

1870  PAUSE 

1872  Filename$  = "" 

1874  Diskdrive$  = 

1876  GOTO  Selectdrive 

1878  ! 

1880  SUBEND 
1882  I 

1 884  1 ************************************************************ 
1386  I 

1 888  SUB  Se!ect_disk 

1890  Select_disk:  ! Original:  13  Nov  1984 

1892  ! Revision:  02  Dec  1987 
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1894 

1896 

1898 
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1930 

1932 
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1974 

1976 

1978 

1980 
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1984 

1986 

1988 

1990 

1992 
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1998 

2000 

2002 

2004 


OPTION  BASE  1 

COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

COM  /Interrupts/  INTEGER  lntr_prty 
COM  /Sys_msi/  Msi_id$ 

COM  /Sys/  Sys_id$ 

INTEGER  Local_prty,Dd,Pt,Choose(1) 

DIM  Disc$(30)l60],Title$[40],Displ${60] 

Locaiprty  = Intrprty 
OFF  KEY 
I 

I Define  the  disk  drives  available  for  this  system,  reserve  the 
I first  characters  for  the  drive  address  and  the  characters  after 
I the  - for  a description  of  the  drive. 

! 

I Example: 

I Disc$(1)-":,7Q0,Q,0  HP  9133H  HARD  disk,  volume  0." 


Displ$  = " SELECT  DISK  DRIVE  ...  Abort  will  cancel.  " 

Title$  = " Available  disk  drives  for  this  system.  " 

Pt  - 1 I allow  only  one  select 

I 

IF  Diskdrive $(  1,1  ]<  THEN  Diskdrive$ 

IF  Msijd$(1 ,1]  < THEN  Msijd$  - SYSTEM $C MSI") 

IF  Msi_id$[1,1]<  THEN  I Must  be  HFS  subdirectory 

Ms_path$  = MsiJd${1,POS(MsiJd$,":")-1]  ! strip  off  subdirs 
IF  Ms_path$[LEN(Ms_path$);1]<  >"/"  THEN  Ms  path$  = Ms_path$&"/" 
Msi  id$---Msi  id$[POS(Msi  id$,":"),LEN(Msi_id$)] 

END  IF” 

Diskdrive$  = TRIM  $ (Diskdrive  $) 

Msi_id$  = TRIM  $ (Msi  Jd$) 

IF  LEN(Diskdrive$)>0  AND  LEN(Msi_id$)>0  THEN 
Disc  $ ( 1 )-  Diskdrive  $ &RPT  $ ( * " , 1 7 -LEN  (Diskdrive  $ )) 

Disc$(1)  = Disc$(1)&"-  Last  selected  disk  drive." 

Dd  = 1 

IF  Diskdrive$<  >Msi_id$  THEN 

Disc$(2)  = MsiJd$&RPT$(B  \17-LEN(Msi_id$)) 

Disc$(2J  = Disc$(2)&"-  Start-up  mass  storage  unit  specifier." 

Dd  = Dd  + 1 
ELSE 

Disc$(1 ) = Disc$(1  )&"  Start-up  MSUS." 

END  IF 
ELSE 

IF  LEN(Msi  id$) >0  THEN 

Disc  $ ( 1 7=  Msi  Jd  $ &RPT$("  " , 1 7 -LEN  (Msi  Jd  $ ) ) 

Disc$(1)  = Disc$(1)&"-  Start-up  mass  storage  unit  specifier." 

Dd  = 1 
ELSE 
Dd  = 0 
END  IF 
END  IF 
Disk:  ! 

I ................  customize  system  drives  here  .................. 

I Follow  format  with  - after  unit  specifier,  description  is 
I optional  but  recommended. 
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2006  ! 

2008  Disc$(Dd  + 1)  = ":, 702,0  - HP  9122  dual  microfloppy  left  drive" 

2010  Disc$(Dd  + 2)  = ":,702,1  - HP  9122  dual  microfloppy  right  drive" 

2012  Disc$(Dd  + 3)  = 703,0  - HP  91 25  single  5.25  floppy  drive" 

2014  Disc$(Dd  + 4)  = ":,1400  - HP  9133H  hard  disk  volume  1" 

2016  I 

2018  Dd  = Dd  + 4 I add  the  number  of  drive  specifiers  above 
2020  I 

2022  IF  Sys_id$[1 ,4]  < > "S300"  THEN 

2024  Disc$(Dd  + 1)  = ":,4,1  - LEFT  internal  series  200" 

2026  Disc$(Dd  + 2)  = ":,4,0  * RIGHT  internal  series  200" 

2028  Dd  = Dd  + 2 

2030  END  IF 

2032  ! 

2034  I 

2036  CALL  Menu_scroll(Displ$,Title$,Disc$(*),Dd,Pt,Choose(*)) 

2038  IF  Pt  = 0 THEN 

2040  Diskdrive  $ = "NO  DISK" 

2042  ELSE 

2044  Dd  = POS(Disc$(Choose(Pt)),"-")-1  ! find  - 

2046  IF  Dd>5  THEN  ! valid  msus 

2048  Diskdrive  $ =TRIM$(Disc$(Choose(Pt))[1  ,Dd]) 

2050  ELSE 

2052  DISP  " ERROR  in  reading  MSUS  from  string,  - chr  not  found.  " 

2054  BEEP 

2056  CALL  Pause_key_on 

2058  Diskdrive$  = "NO  DISK" 

2060  END  IF 

2062  END  IF 

2064  Diskselected:OFF  KEY 
2066  SUBEXIT 

2068  SUBEND 
2070  ! 

2074  ! 

2076  SUB  Enterfilename(Ac$) 

2078  Enterfilename:  ! Original:  13  Nov  1984 

2080  ! Revision:  1 0 Dec  1 990  includes  HFS  directories 

2082  OPTION  BASE  1 

2084  COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

2086  COM  /Interrupts/  INTEGER  lntr_prty 

2088  INTEGER  l,Ascii_num,Maskflag,Namelength 

2090  DIM  Test$(256],Hfs_temp$(1 61] 

2092  Namelength  = 1 0 

2094  IF  LEN(Ms_path$) > 0 THEN  OUTPUT  KBD  USING  "K,#";"#"  &Ms_path$&"HR 
2096  DISP  " ENTER  HFS  directory  PATH  (no  file)"; 

2098  IF  Ac$  < > "PATH"  THEN 

2100  DISP  ",  ENTER  / for  HFS  ROOT  or  null  for  LIF..."; 

2102  END  IF 

2104  LINPUT  Hfs_temp$ 

2106  Hfs_temp$=TRIM$(Hfs_temp$) 

2108  IF  LEN (Hf s_temp  $ ) > 0 THEN 

2110  IF  LEN(Hfs_temp$)  > 1 AND  Hfs_temp$[LEN(Hfs_temp$);1]<  >"/"  THEN 

21 12  Hfs_temp$  =Hfs_temp$&"/" 

2114  END  IF 

2116  IF  LEN(Hfs_temp$)  = 1 THEN  Hfs_temp$  = 
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2118 
2120 
2122 
2124 
2126 
2128 
2130 
2132 
2134 
2136 
2138 
2140 
2142 
2144 
2146 
2148 
21  g0 
2152 
2154 
2156 
2158 
2160 
2162 
2164 
2166 
2168 
2170 
2172 
2174 
2176 
2178 
2180 
2182 
2184 
2186 
2188 
2190 
2192 
2194 
2196 
2198 
2200 
2202 
2204 
2206 
2208 
2210 
2212 
2214 
. 2216 
2218 
2220 
2222 
2224 
2226 
2228 


Namelength  = 1 4 
END  IF 

IF  Ac$  = "PATH"  THEN 
Ms_path$  = Hfs_temp$ 

SUBEXIT 
END  IF 

IF  LEN(Filename$)>0  THEN  OUTPUT  KBD  USING  "K,#";"jr&FiIename$&"H" 
Efn:  ! 

DISP  " ENTER  the  FILE  NAME  ... 

SELECT  Ac$ 

CASE "CAT" 

DISP  "(ENTER  CAT  mask*  or  ENTER  null  to  CAT)"; 

CASE  "ABORT" 

DISP  "(ENTER  null  to  ABORT)  "; 

CASE  "VALID" 

DISP  "(must  be  a VALID  name!)  "; 

END  SELECT 
LINPUT  Test$ 

Test$  =TRIM$(Test$) 

IF  LEN(Test$)  =0  AND  Ac$  = "VALID"  THEN  GOTO  Enterfilename 
IF  LEN(Test$)  =0  THEN  Abortline 
IF  LEN(Test$)>  Namelength  THEN 
BEEP 

DISP  "ERROR  in  NAME  ENTRY  - max  °;Namelength;c  chars,  you  have  "; 
DISP  LEN(Test$);"  " 

WAIT  1.8 

OUTPUT  2 USING  "K,#";"#"&Test$&"H" 

GOTO  Efn 
END  IF 

IF  POS(Test$,"*")>  1 THEN 

Test$  =Test$[1  ,POS(Test$,"  *")-1 1 
Maskf  lag  = 1 
ELSE 

Maskf  lag  = 0 
END  IF 

FOR  i-1  TO  LEN(Test$) 

Ascii_num  = N UM (Test  $ [I] ) 

SELECT  Asciijnum 

CASE  65  TO  90,95,97  TO  122,48  TO  57 
lAllowed  characters 
CASE  ELSE 
BEEP 

DISP  "ERROR  in  NAME  ENTRY-ILLEGAL  CHARACTERS,  TRY  AGAIN." 
WAIT  1.8 

OUTPUT  2 USING  "K,#";"#"&Test$&"H" 

GOTO  Efn 
END  SELECT 
NEXT  I 

IF  Maskflag  THEN 

Filename$  =Test$&B*" 

ELSE 

Filename  $ =Test$ 

END  IF 

Ms_path$  = Hfstemp$ 

SUBEXIT 

Abortiine:Filename$  = "" 
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2230  IF  Ac$  = "CAT"  THEN  Ms  path$  =Hfs  temp$ 

2232  SUBEXIT 
2234  SUBENO 
2236  I 

2238  I 

2240  ! 

2242  SUB  File_menu(Mask$,Ftype$,Fls$(*), INTEGER  Fls_cnt,Dir_on,Prt_on) 
2244  File_menu:  I 


2246 

2248 

2250 

2252 

2254 

2256 

2258 

2260 

2262 

2264 

2266 

2268 

2270 

2272 

2274 

2276 

2278 

2280 

2282 

2284 

2286 

2288 

2290 

2292 

2294 

2296 

2298 

2300 

2302 

2304 

2306 

2308 

2310 

2312 

2314 

2316 

2318 

2320 

2322 

2324 

2326 

2328 

2330 

2332 

2334 

2336 

2338 

2340 


I Original:  29  Jun  1987,  G.  Koepke 
1 Revision:  02  Dec  1987,  07:00 
OPTION  BASE  1 
DEG 

COM  /Sys/  Sysjd${10] 

COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

COM  /Interrupts/  INTEGER  lntr_prty 

COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

DIM  Directory$(600)[80],Bd$(600)[71] 

DIM  D$[80],T$[51  ],lds$[40],Stat$l1  ],Test$[256] 

INTEGER  Bd  cnt.File  cnt,l,C  cnt,C0(1 ), Format  error, End_search 
IF  Fls_cnt>0  THEN  ALLOCATE  INTEGER  Choose(Fls_cnt) 

I 

I Catalog  the  disk  specified 
! 

End_search  = 0 

REPEAT  I Generate  path  to  file  and  extract  file  name. 

ON  ERROR  GOTO  Cat_errors 
DISP  " Reading  the  Directory  ..." 

IF  LEN(Ms_path$)>0  THEN 

MASS  STORAGE  IS  Ms_path$[1,LEN(Ms_path$)-1]&Diskdrive$ 
ELSE 

MASS  STORAGE  IS  Diskdrive  $ 

END  IF 

CAT  TO  Directory $<*);NO  HEADER, COUNT  File_cnt 
OFF  ERROR 
I 

I set  up  array  of  legal  file  names. 

! 

Bd  cnt  = 0 
MAT  Bd$=  ("") 

FOR  I = 1 TO  Fiie_cnt 

SELECT  Directory $(1)132, 36] 

CASE  Ftype$  I Ftype$  = "BOAT  " or 

! Ftype$  = "PROG  " 

IF  LEN(Mask$)>0  THEN  ! Test  for  mask$ 

IF  Directory $(l)[1,LEN(Mask$)]=Mask$  THEN 
Bd_cnt  = Bd_cnt  + 1 

Bd$(Bd_cnt)  = Directory $(l)(1;14]&"  - "&Ftype$ 

END  IF 
ELSE 

Bd_ent  = Bd_cnt  + 1 

Bd$(Bd_cnt)  = Directory $(l)[1;14]&"  - "&Ftype$ 

END  IF 

CASE  "DIR  " ! plus  all  "DIR  " listings 

Bd_cnt  = Bd_cnt  + 1 

Bd  $ (Bd_cntf  = Directory  $ (l){  1 ; 1 4]  &"  - DIR  " 

CASE  ELSE 
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2342 

2344 

2346 

2348 

2350 

2352 

2354 

2356 

2358 

2360 

2362 

2364 

2366 

2368 

2370 

2372 

2374 

2376 

2378 

2380 

2382 

2384 

2386 

2388 

2390 

2392 

2394 

2396 

2398 

2400 

2402 

2404 

2406 

2408 

2410 

2412 

2414 

2416 

2418 

2420 

2422 

2424 

2426 

2428 

2430 

2432 

2434 

2436 

2438 

2440 

2442 

2444 

2446 

2448 

2450 

2452 


END  SELECT 
NEXT  I 

IF  LEN(Ms_path$)  >0  AND  Bd_cnt>0  AND  Fls_cnt>0  THEN 
Bd_cnt  = Bdcnt  + 1 

Bd$(Bd_cnt)  = " MOVE  back  up  ONE  Directory  level/ 

Bd_cnt  = Bd  cnt  + 1 

Bd$(Bd_cnt)  = " — RETURN  to  ROOT  Directory/ 

END  IF 

I 

I set  up  file  menu 
I 

D$  = " Select  "&VAL$(Fls_cnt)&"  file  name(s)  for  data  entry/ 

T$  = "List  of  "&Ftype$&"files  and  DIRs  on  "&Diskdrive$ 

IF  LEN(Mask$)>0  THEN 
T$  =T$&"  mask  = "&Mask$ 

END  IF 

IF  Sd_ent  > 0 THEN 

IF  Dirjan>0  THEN  GOSUB  Read_data  id 
IF  Prt_pn  THEN 

GOSUB  List_directory 
End_search  = 1 
ELSE 

Cent » FIs  jsnt 
DISP  CHR$(1 2) 

IF  Fis^cnt  > 0 THEN 

CALL  Menu_scroll(D$JT$fBd$(*)fBd„cntJC_cnt,Choose(*)) 
ELSE 

CALL  Menu_scroll(D$(T$,Bd$r),Bd_cnt,C_cnt,CO(#)) 

END  IF 

I 

I transfer  file  names  to  Fls$(*). 

I 

IF  C_cnt  = 0 THEN  I selection  process  aborted 
End_search  = 1 
MAT  Fis$  = ("") 

ELSE 

MAT  SORT  Chooser) 

FOR  I = 1 TO  C_cnt 

IF  Bd$(Choose(l))n  8,22]  = Ftype$  THEN 
Fls$(l)  = Bd$(Choose(l))n;141 
End_search  = 1 

ELSE  ! it  must  be  a Directory  or  message. 

SELECT  Bd$(Choose(l))l1 8,22] 

CASE  "up  ON"  I move  up  one  directory 
LOOP 

Mspath  $ = Ms_path  $ ( 1 , LEN  (Ms_path  $ )- 1 ] 
EXIT  IF  LEN(Ms_path$)=0 

Test  $ = Ms_path  $ [LEN(Ms_path  $ ) ; 1 ] 

EXIT  IF  Test$  = "/" 

END  LOOP 

CASE  "ROOT  " I jump  to  root  directory 
Ms_path$  = 

CASE  "DIR  " I add  directory  to  Ms_path$ 

Test$  = TRIM  $ (Bd  $ (Choosed  W 1 ,14]) 

Ms_path$  =Ms_path$&Test$&"/" 

CASE  ELSE 
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2454 

2456 

2458 

2460 

2462 

2464 

2466 

2468 

2470 

2472 

2474 

2476 

2478 

2480 


DISP  "ERROR  in  directory  jump" 
PAUSE 
END  SELECT 
I = C_cnt 
END  IF 
NEXT  I 
END  IF 


END  IF 
ELSE 


DISP  " This  directory  contains  no  ";Ftype$,°"  files  ... 
WAIT  2.5 


End  search  = 1 
END  IF" 

DISP  CHR$(1 2) 


2482  UNTIL  End  search 

2484  SUBEXIT 

2486  Cat_errors:l 

2488  DISP  " ERROR  ...  ";ERRM$ 

2490  BEEP 

2492  CALL  Pause_key  on 

2494  DISP  CHR$02) 

2496  C cnt  = 0 

2498  MATFIs$=("") 

2500  SUBEXIT 

2502  I 

2504  I //////////////////////////////////////////////////// 

2506  I 

2508  ReadjjataJd:  I This  routine  expects  to  see  lds$  from 
2510  I GRAPH_DATA  raw  data  files. 

2512  DISP  " Reading  file  contents  ...  Please  stand  by.  B 
2514  PRINT  TABXY(1, 18);"  Reading 

2516  FOR  I = 1 TO  Bd  cnt  ! each  BDAT  file 
2518  PRINT  TABXY(  11,18); 

2520  PRINT  USING  "3D,4A,3D,2A,#";I,"  of  ",Bd_cnt,".  " 

2522  lds$  = "Data  not  recognized." 

2524  IF  Bd$(l)[1 8,22]  = "BDAT  " THEN 

2526  ON  ERROR  GOTO  Not_recognized 

2528  ASSIGN  @lo_path  TO  Bd$(l)[1;14] 

2530  ENTER  @lo_path;Stat$ 

2532  SELECT  Stat$ 

2534  CASE  "N" 

2536  ENTER  @lo_path,ids$ 

2538  CASE  "Y" 

2540  lds$  = "Complete  graph  in  GRAPH  DATA  form." 

2542  END  SELECT 

2544  Not_recognized:ASSIGN  @lo_path  TO  # 

2546  OFF  ERROR 

2548  IF  Dir_on  = 2 THEN 

2550  GOSUB  InterpretJ 

2552  IF  Format_error  THEN  GOTO  Other_format 

2554  GOTO  Go_on 

2556  END  IF 

2558  Other_format:l 

2560  Bd$(l)I23,71  ] = " ...  "&lds$ 

2562  END  IF 

2564  Go  on:NEXT  I 
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2566  PRINT  TABXYd  ,1 8);RPT$("  ",40); 

2568  DISP  CHR$(1 2); 

2570  RETURN 

2572  ! 

2574  I /////////////////////////////////////////////////// 

2576  ! 

2578  Interpret^ : ! This  is  used  to  interpret  ID  strings. 

2580  Format_error  = 1 

2582  ! identify  this  particular  format 

2584  RETURN 

2586  ! 

2588  ! /////////////////////////////////////////////////// 

2590  l 

2592  Listjjirectory:  I This  routine  will  provide  a tabular  listing  of 
2594  I the  directory  along  with  !ds$  if  provided 

2596  I 

2598  DISP  " Listing  directory  ...  " 

2600  ON  TIMEOUT  7,10  GOTO  Printer Jcaput 

2602  PRINTER  IS  Printer 

2604  PRINT  USING  "//" 

2606  PRINT  T$ 

2608  IF  LEN(Ms_path$J  >0  THEN  PRINT  "NFS  Path:  ";Ms  path$ 

2610  PRINT  RPT$r-"s80) 

2612  PRINT  "File  name"; 

2614  IF  Dir_on  THEN 

2616  PRINT  " - TYPE  ...  contents" 

2618  ELSE 

2620  PRINT  * - TYPE" 

2622  END  IF 

2624  PRINT  RPT$("~",80) 

2626  FOR  I * 1 TO  Bd_cnt 

2628  IF  Bd$(l)[18,22]  = Ftype$  OR  Bd$(l)[1 8,22]  = "DIR  "THEN 

2630  PRINT  Bd$(l) 

2632  END  IF 

2634  NEXT  I 

2636  PRINT  RPT$(’J\80) 

2638  PRINT 

2640  PRINTER  IS  CRT 

2642  OFF  TIMEOUT  7 

2644  RETURN 

2646  Printer_kaput:DISP  " Printer  not  responding  ...  listing  aborted.  " 

2648  r BEEP 
2650  ' WAIT  1.8 
2652  OFF  TIMEOUT  7 

2654  RETURN 

2656  SUBEND 
2658  ! 

2660  I * * **** **************** 

2662  ! 

2664  SUB  Menu_scroll(D$„T$,ltems$(*), INTEGER  ltem_cnt„To_selecttChoose(*)) 

2666  Menu_scrolI:l  Original:  22  Jun  1987,  Galen  Koepke,  NBS  723.04 
2668  ! Revision:  22  Aug  1990,  12:00,  Dennis  Camel! 

2670  I 

2672  I A general  purpose  menu  utility  for  scrolling  items  and 

2674  ! selecting  either  a fixed  number  or  a random  number 

2676  I of  items. 
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2678 
2680 
2682 
2684 
2686 
2688 
2690 
2692 
2694 
2696 
2698 
2700 
2702 
2704 
2706 
2708 
2710 
2712 
2714 
2716 
2718 
2720 
2722 
2724 
2726 
2728 
2730 
2732  Def 
2734 
2736 
2738 
2740 
2742 
2744 
2746 
2748 
2750 
2752 
2754 
2756 
2758 
2760 
2762 
2764 
2766 
2768 
2770 
2772 
2774 
2776 
2778 
2780 
2782 
2784 
2786 
2788 


! for  fixed  : To_select  > 0 
! for  random  : To_select  = -1 

! The  items  are  arranged  in  screens  of  1 5 items  each  and 
! the  user  may  access  screens  via  softkeys.  There  may  be 
! up  to  40  screens  or  600  items  to  choose  from. 

! Maximum  sizes:  D$[80],  T$[51],  ltems(#)[70] 

! Items$(*)  contains  the  item  descriptions 
! Item_cnt  is  the  number  of  items  in  ltems$(#) 

! Choose(*)  is  dimensioned  to  the  number  of  required  choices 
! and  will  be  filled  with  the  item  numbers  chosen. 

! To_select  is  the  number  of  required  choices. 

I 

OPTION  BASE  1 
PRINTER  IS  CRT 
DEG 

GOSUB  Def_variables 
GOSUB  Define_screens 
GOSUB  Make_selections 
IF  Null_file  THEN  ! reset  to  zero 
Item  cnt=0 
ltems$(1)  = "" 

To  select  = 0 1 no  valid  selections 

END  IF 
SUBEXIT 
! 

1 //////////////////////////////////////////////////// 

I 

variables:! 

COM  /Interrupts/  INTEGER  lntr_prty 

COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

COM  /Sys/  Sys_id$[10] 

I 

INTEG ER  Screen_cnt, ltems_per_scn,  First  Jtem (40), Last Jtem (40) 
INTEGER  l,J,K,FirstJine,LastJine,Active_screen,Pointer,Last_pt 
INTEGER  Local_prty, Skips, Knobcount,Pointeractive,KO,Null_file 
INTEGER  Exit_flag(T emp,Random_select,lndx 
DIM  Marker$[8],Test$[256] 

! 

! initialize  parameters 
I 

Loca!_prty  = Intr _prty 

IF  Local jjrty  < 1 THEN  Local^prty  = 10 

IF  LEN(SysJd$)  =0  THEN  Sysjd$  = SYSTEM  $("  SYSTEM  ID") 

IF  ltem_cnt<1  THEN 
Null_f  ile  — 1 
ltem_cnt  = 1 
To_select  = 0 

ltems$(1  ) = "***  Empty  *##K 
ELSE 

Null_file  = 0 
END  IF 

IF  To  _select=1  THEN 

Random  seiect  = 1 ! choose  random  number  of  items 

To_select  = 0 ! needed  for  softkeys 

END  IF 

IF  To_select>ltem_cnt  THEN  T o_seiect  = ltem_cnt 
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2790 

2792 

2794 

2796 

2798 

2800 

2802 

2804 

2806 

2808 

2810 

2812 

2814 

2816 

2818 

2820 

2822 

2824 

2826 

2828 

2830 

2832 

2834 

2836 

2838 

2840 

2842 

2844 

2846 

2848 

2850 

2852 

2854 

2856 

2858 

2860 

2862 

2864 

2866 

2868 

2870 

2872 

2874 

2876 

2878 

2880 

2882 

2884 

2886 

2888 

2890 

2892 

2894 

2896 

2898 

2900 


MAT  Choose = (999) 

Skips  = 0 
Knobcount-0 
Doneflag  =0 

Marker$  = " = * = >"&RPT$(CHR$(8),4) 

RETURN 

! 

I //////////////////////////////////////////////////// 

! 

Define_screens:l  Set  up  screens  of  1 5 items  each. 

! 

Items_per_scn  ~ 1 5 ! Maximum  number  of  dispiayable  items 

IF  INT(ltem_cnt/ltems__per_scn)  = ltem_cnt/ltems_per_scn  THEN 
Screen_cnt  = INT(ltem_cnt/ltems_per_scn) 

ELSE 

Screen_ent  - INT(ltern_cnt/ltems_per_scn)  + 1 
END  IF 

J*1 

FOR  1 » 1 TO  Screen_cnt  ! set  up  each  screen 
Firstjtem(l)  =J 

IF  J + ltems=per_scn-1  cltemcnt  THEN 
Last  item  (I)  = J + ltems_per_scn-1 
J as  j + stems  per  sen 
ELSE 

Lastjtem(l)  = Item  ent 
END  IF 
NEXT  I 
RETURN 
I 

I /////////////////////////////////////////////////// 

! 

Make_seleetions:!  MENU  setup  and  use. 

Active_screen  - 1 I first  screen  is  active 

Firstjine  - 2 I first  printed  line  on  screen  = 2 or  greater. 

GO  SUB  Write_screen  I activate  screen  at  Active_screen 
S and  set  Firstjine  and  Lastjine  for  Pointer 
S write  Marker$  to  first  non-selected  line. 

KO-O  I Keys  start  at  zero 

Exitjlag  = 0 I allow  ENTER  key  to  exit  when  selections  filled. 
Keyjoop:  I 

ON  KBDfLocal_prty  GOSUB  Process_kbd 
ON  KNOB  .01  ,Local=prty  GOSUB  Move_pointer 
IF  Random_select  THEN 

I set  keys  for  random  selection 
DISP  D$ 

ON  KEY  KO  LABEL  " Select", Local_prty  GOSUB  Select  random 
ON  KEY  KO  + 9 LABEL  " Accept", Local_prty  GOTO  Exitjine 
ELSE  ! set  key  KO  for  fixed  selection 
IF  Skips  <To_select  THEN 
DISP  D$  ‘ 

IF  To_select>  1 THEN 

Test$  = " Select  B &VAL$ (Skips  + 1 )&"  of  B&VAL$(To_select) 
ELSE 

Test$  = " Select" 

END  IF 

ON  KEY  KO  LABEL  Test $, Local jjrty  GOSUB  Select Jixed 
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2902  ELSE 

2904  IF  To_select  > 0 THEN 

2906  DISP  " Selection  process  complete  ..." 

2908  ELSE 

2910  DISP  ’ Menu  for  information  only  ...  " 

2912  END  IF 

2914  ON  KEY  KO  LABEL  " Accept", Local_prty  GOTO  Exitjine 

2916  END  IF 

2918  END  IF 

2920  IF  Active  screen  < Screen_cnt  THEN 

2922  ON  KEY  KO+1  LABEL  " Next  Screen", Local_prty  GOSUB  Next_screen 

2924  ELSE 

2926  OFF  KEY  KO  + 1 

2928  END  IF 

2930  IF  Active_screen  > 1 THEN 

2932  ON  KEY  KO  + 2 LABEL  ’ Last  Screen", Local_prty  GOSUB  Last  screen 

2934  ELSE 

2936  OFF  KEY  KO  + 2 

2938  END  IF 

2940  IF  Skips  >0  OR  Random  select  THEN 

2942  ON  KEY  K0  + 3 LABEL  " Reset  Select", Local_prty  GOSUB  Select_reset 

2944  ELSE 

2946  OFF  KEY  KO  + 3 

2948  END  IF 

2950  IF  To  select  >0  OR  Random_select  THEN 

2952  ON  KEY  KO  + 4 LABEL  " Abort  ",Local_prty  GOTO  Escapejine 

2954  ELSE 

2956  OFF  KEY  KO  + 4 

2958  END  IF 

2960  IF  Screen_cnt>2  THEN 

2962  ON  KEY  KO  + 6 LABEL  "Jump  to  Screen ",Local_prty  GOSUB  Jump_to_scn 

2964  ELSE 

2966  OFF  KEY  KO  + 6 

2968  END  IF 

2970  IF  Exitjlag  THEN  Exitjine 

2972  GOTO  Keyjoop 

2974  Escape  line:Skips  = 0 
2976  MAT  Choose  = (0) 

2978  To  select  = 0 

2980  ExitJine:OFF  KEY 

2982  “MAT  SORT  Chooser)  , 

2984  OFF  KNOB 

2986  OFF  KBD 

2988  OUTPUT  KBD;CHR$(255)&CHR$(75); 

2990  PRINT  CHR$(1 28); 

2992  I everything  cleared,  now  go  back  to  work. 

2994  RETURN 

2996  ! 

2998  I /////////////////////////////////////////////////// 

3000  ! 

3002  Next  screen:  ! 

3004  OFF  KBD 

3006  OFF  KNOB 

3008  OFF  KEY 

3010  IF  Active_screen  = Screen_cnt  THEN  RETURN 

3012  Active_screen  = Active_screen  + 1 
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3014  GOSUB  Write  screen 

3016  RETURN 

3018  I 

3020  I /////////////////////////////////////////////////// 

3022  ! 

3024  Last_screen:  ! 

3026  OFF  KBD 

3028  OFF  KNOB 

3030  OFF  KEY 

3032  SF  Activejcreen  - 1 THEN  RETURN 

3034  Active_screen  = Active_screen- 1 

3036  GOSUB  Write_screen 

3038  RETURN 

3040  8 

3042  I llllllllllllllllllllllllllllllllllllllllllllllllll 

3044  8 

3046  Jumpjo_errors:DISP  " Not  a valid  screen  number  ...  try  again.  ° 

3048  BEEP 

3050  WAIT  1 .8 

3052  Jump  to  sen:  8 

3054  0~PF~KBD 

3056  OFF  KNOB 

3058  OFF  KEY 

3060  DISP  " ENTER  the  screen  number  desired  (1  to  ".‘Screen  cnt;")." 
3062  LIN  PUT  Test$ 

3064  Test$  - TRIM  $ (Test$ ) 

3066  IF  LEN(Test$)  = 0 THEN  Jump  Jo  ret  urn 

3068  ON  ERROR  GOTO  Jump  tojrrors 

3070  Temp  = INT(VAL(Test$)| 

3072  OFF  ERROR 

3074  IF  Temp<1  OR  Temp>Screen_cnt  THEN  Jump  to  errors 

3076  Aetive_screen  - Temp 

3078  GOSUB  Writescreen 

3080  Jump  to  return:  I 

3082  DISP  CHR$(1 2} 

3084  Test$ 

3086  RETURN 

3088  I 

3090  8 ////////////////////////////////////////////////// 

3092  ! 

3094  Seiectjixed:!  , 

3096  OFF  KBD 

3098  OFF  KNOB 

3100  OFF  KEY 

3102  IF  NOT  Pointeractive  THEN 

3104  DISP  "NO  additional  selections  for  this  screen." 

3106  BEEP 

3108  WAIT  2 

3110  DISP  CHR$(1 2); 

3112  RETURN 

3114  END  SF 

3116  IF  Skips  = To  ^select  THEN 

3118  IF  To  select « 0 THEN 

3120  DISP  "This  menu  is  for  information  only,"; 

3122  DISP  B no  selection  allowed," 

3124  ELSE 
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3126 

3128 

3130 

3132 

3134 

3136 

3138 

3140 

3142 

3144 

3146 

3148 

3150 

3152 

3154 

3156 

3158 

3160 

3162 

3164 

3166 

3168 

3170 

3172 

3174 

3176 

3178 

3180 

3182 

3184 

3186 

3188 

3190 

3192 

3194 

3196 

3198 

3200 

3202 

3204 

3206 

3208 

3210 

3212 

3214 

3216 

3218 

3220 

3222 

3224 

3226 

3228 

3230 

3232 

3234 

3236 


OISP  "All  selections  have  been  filled,"; 

DISP  " 'Select  Reset'  to  repeat." 

END  IF 
BEEP 
WAIT  2 

DISP  CHR$(1 2); 

RETURN 
END  IF 

Skips  = Skips  + 1 

Choose  (Skips)  = First  item  (Active  screen)  + Pointer-First Jine 

PRINT  CHR$(  129);  F inverse  video 

PRINT  T ABXY ( 1 0,Pointer);ltems$  (Choose(Skips)) 

PRINT  CHR$(1 28); 

PRINT  TABXY(1  .Pointer); 

SELECT  Pointer 
CASE  Firstjine 

GOSUB  Point_forward 
CASE  Lastjine 

GOSUB  Point  backward 
CASE  ELSE 

I move  forward  unless  it  requires  wrapping  to  beginning. 

IF  Skips-1  >0  THEN  I check  for  selected  items. 

I = Pointer-First  line 
LOOP 
K = 0 

FOR  J = 1 TO  Skips 

IF  First Jtem(Active_screen)  + I = Choose(J)  THEN  K = 1 
NEXT  J 
EXIT  IF  K =0 
1 = 1 + 1 

IF  I + Firstjine  > Lastjine  THEN  K = -1 
EXIT  IF  K = -1 
END  LOOP 
IF  K =0  THEN 

GOSUB  Point_forward 
ELSE 

GOSUB  Point_backward 
END  IF 
ELSE 

GOSUB  Pointjorward 
END  IF 
END  SELECT 
RETURN 
! 

! ////////////////////////////////////////////////// 

! 

Select_random:! 

OFF  KBD 
OFF  KNOB 
OFF  KEY 
Test$  = "NO" 

IF  NOT  Pointeractive  THEN 

DISP  "NO  additional  selections  for  this  screen." 

BEEP 
WAIT  2 

DISP  CHR$(1 2); 
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3238 

3240 

3242 

3244 

3246 

3248 

3250 

3252 

3254 

3256 

3258 

3260 

3262 

3264 

3266 

3268 

3270 

3272 

3274 

3276 

3278 

3280 

3282 

3284 

3286 

3288 

3290 

3292 

3294 

3296 

3298 

3300 

3302 

3304 

3306 

3308 

3310 

3312 

3314 

3316 

3318 

3320 

3322 

3324 

3326 

3328 

3330 

3332 

3334 

3336 

3338 

3340 

3342 

3344 

3346 

3348 


RETURN 
END  IF 

FOR  I = 1 TO  To=select 

IF  Choose(l)  = Firstjtem(Active  screen)  + Pointer-Firstjine  THEN 
Indx  = I 

Test$  = "YES" 

END  IF 
NEXT  I 

SELECT  Test$ 

CASE  "YES"  ! Selected  item  is  tagged  ...  untag 

IF  Pointer  < > Last_item(Active_screen)  + 1 AND  Pointer  < > 1 7 THEN 
PRINT  CHR$(128);l  normal  video 
ELSE 

PRINT  CHR$(132);I  underline  video 
END  IF 

PRINT  TABXYd  0,Pointer);ltems$(Choose(lndx)) 

FOR  t-lndx  TO  To_select-1 
Ghoose(S)  =Choose(I  + 1 ) 

NEXT  I 

Choose(To_select)  = 999 
T Deselect = T o_select- 1 

CASE  "NO”  ! Selected  item  is  untagged  ...  tag  it 

To^select = To^seiect  + 1 

Choose(To_select)  = FirstJtem(Activejsereen)  + Pointer-Firstjine 
IF  Pointer  < >Lastjtem(Active_screen)  + 1 AND  Pointer  < >17  THEN 
PRINT  CHR$(129);I  inverse  video 
ELSE 

PRINT  CHR$(133);I  inverse  video  with  underline 
END  IF 

PRINT  TABXYd  0,Pointer);ltems${Choose(To_select)) 

END  SELECT 
PRINT  CHR$(1 28); 

PRINT  TABXYd , Pointer); 

RETURN 

I 

S ////////////////////////////////////////////////// 

! 

Selectjeset:  IClear  Choose  file 

OFF  KBD 
OFF  KNOB 
OFF  KEY 

IF  Random_seiect  THEN  To_select  = 0 
Skips  = 0 

MAT  Choose  = (999) 

GOSUB  Write_screen 
RETURN 

I 

! ///////////////////////////////////////////////// 

I 

Process_kbd:!  Allow  use  of  arrows  and  enter  key  in  addition  to  soft. 
Test$=K8D$ 

IF  LEN(Test$)  = 1 AND  Test$[1  J)<  >CHR$(32)  THEN 
BEEP  80.,.  1 
RETURN 
END  IF 

IF  Test${1 ,1)  ~CHR$(32)  THEN  GOSUB  Point  forward 
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3350 

3352 

3354 

3356 

3358 

3360 

3362 

3364 

3366 

3368 

3370 

3372 

3374 

3376 

3378 

3380 

3382 

3384 

3386 

3388 

3390 


IF  Test$[1,1]<>CHR$(255)  THEN  RETURN 
SELECT  Test$[2,2] 

CASE  CHR$(255) 


! do  nothing 


CASE  "V","T" 


GOSUB  Point_forward 
CASE  "AVW 


GOSUB  Point_backward 
CASE  "E","s","t"/&" 


IF  Random_select  THEN 


GOSUB  Select_random 


ELSE 


IF  Skips  <To_select  THEN 


GOSUB  Select_fixed 
ELSE 

l exit  routine 


Exit  flag  = 1 
END  IF” 


END  IF 


CASE  ELSE 
BEEP  80.,. 1 


3392  END  SELECT 

3394  Test$  = 

3396  RETURN 

3398  ! 

3400  I ////////////////////////////////////////////////// 

3402  1 

3404  Point_forward:Knobcount  = 5 
3406  GOSUB  Move_pointer 

3408  RETURN 

3410  Point_backward:Knobcount  = -5 
3412  GOSUB  Move_pointer 

3414  RETURN 

3416  ! 

3418  ! ////////////////////////////////////////////////// 

3420  ! 

3422  Jog_pointer:l  Move  the  selection  pointer  on  the  active  screen. 

3424  I without  regard  to  selected  values 

3426  IF  Knobcount>0  THEN  ! Move  forward 

3428  Pointer  = Pointer  + 1 

3430  , ELSE  ! Move  backward 

3432  Pointer  = Pointer- 1 

3434  END  IF 

3436  IF  Pointer  < First Jine  THEN  Pointer  = Last Jine 

3438  IF  Pointer  > Last  Jine  THEN  Pointer  = Firstjine 

3440  RETURN 

3442  ! 

3444  I ///////////////////////////////////////////////////////// 

3446  ! 

3448  Move_pointer:l  Control  pointer  to  avoid  re-selection  of  items 

3450  IF  NOT  Pointeractive  THEN  RETURN  I No  selections  to  be  made. 

3452  Knobcount  = Knobcount  + KNOBX-KNOBY 

3454  IF  ABS(Knobcount)  < 4 THEN  RETURN 

3456  Last__pt  = Pointer 

3458  GOSUB  Jog_pointer 

3460  IF  Skips  >0  THEN 


B103 


3462 

3464 

3466 

3468 

3470 

3472 

3474 

3476 

3478 

3480 

3482 

3484 

3486 

3488 

3490 

3492 

3494 

3496 

3498 

3500 

3502 

3504 

3506 

3508 

3510 

3512 

3514 

3516 

3518 

3520 

3522 

3524 

3526 

3528 

3530 

3532 

3534 

3536 

3538 

3540 

3542 

3544 

3546 

3548 

3550 

3552 

3554 

3556 

3558 

3560 

3562 

3564 

3566 

3568 

3570 

3572 


LOOP 

J = Pointer-First  Jine 
FOR  I = 1 TO  Skips 

IF  First Jtem(Active_screen)  + J = Choose(l)  THEN  J - 999 
NEXT  I 

IF  j = 999  AND  Pointer  = Last_pt  THEN  Pointeractive  = 0 
EXIT  IF  Pointeractive  = 0 

IF  J = 999  THEN  GOSUB  Jog_pointer 
EXIT  IF  J<  >999 
END  LOOP 
END  IF 

Knobcount  = 0 

OUTPUT  KBD;CHR$(255)&CHR${84);  I Bring  screen  home 
IF  last_pt  = Last  Jine  THEN  PRINT  CHR$(132); 

PRINT  "" 

IF  Pointeractive  THEN  I Pointer  active 
IF  Pointer  - Last  Jine  THEN 
PRINT  CHR$(1 32); 

ELSE 

PRINT  CHR$d  28); 

END  IF 

PRINT  TABXYd  ,Pointer);Marker$;CHR$d  28); 

END  IF 
RETURN 
! 

! ////////////////////////////////////////////////// 

I 

Write=screen:!  Write  the  screen  pointed  to  by  Active_screen 
I home  and  clear  screen 

OUTPUT  KBD;CHR$(255)&CHR$(84)&CHR$(255)&CHR$(75); 
Knobeount  = KNOBX-KNOBY  I Clear  knob  and  keyboard 
Knobcount  - 0 
Test$=KBD$ 

Test$ 

S 

PRINT  TABXYd fFirstJine-1);CHR$(1 32);"  Item  #|  Screen 
PRINT  USING  "##2D(4At2D„3A";Active_screenJ  of  ";Screen_cnt;B 
PRINT  T$;RPT $("  ",51-LEN(T$)); 

PRINT  TABXY(80, First  lined );"  | B;CHR$(1 28); 

J-0 

REPEAT 

IF  J = LastJtem(Active_screen)-FirstJtem(Active_screen)  THEN 
PRINT  CHR$(1 32); 

PRINT  TABXYd  .Firstjine  + J);RPT$C  "#80| 

ELSE 

PRINT  CHR$(1 28); 

END  SF 

PRINT  TABXY(5tFirstJine  + J); 

PRINT  USING  "3DtAt#";FirstJtem(Active_screen)  + Jf"  j B 
IF  Random_select  THEN 
FOR  I =s  1 TO  To  select 

IF  First  item (Active_screen)  + J -Choose(l)  THEN 
PRINT  CHR$(1 29); 

END  IF 
NEXT  I 
ELSE 
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3574  IF  Skips  >0  THEN  ! make  this  line  inverse  video 

3576  FOR  I = 1 TO  Skips 

3578  IF  First Jtem (Active  screen)  + J = Choose(l)  THEN 

3580  PRINT  CHR$(1 29); 

3582  END  IF 

3584  NEXT  I 

3586  END  IF 

3588  END  IF 

3590  PRINT  TABXY(  10, First  line + J);ltems$  (First  item(Active_screen)  + J) 

3592  PRINT  TABXY(80,FirstJine  + J);"  | 

3594  J=J  + 1 

3596  UNTIL  J > = (LastJtem(Active_screen)-FirstJtem(Active_screen)  + 1 ) 
3598  Lastjine  = LastJtem(Active_screen)-FirstJtem(Active_screen) 

3600  Lastjine  = Last  line  + First Jine 
3602  ! 

3604  ! set  marker  to  first  non-selected  item. 

3606  ! 

3608  Pointeractive  = 0 

3610  IF  To_select>0  OR  Random_select  THEN  Pointeractive  = 1 

3612  IF  Skips  >0  AND  Pointeractive  = 1 THEN  I find  first  non-selected  item 

3614  J = 0 

3616  LOOP 

3618  Pointer  = First  line  + J 

3620  FOR  1 = 1 TO  Skips 

3622  IF  FirstJtem(Active_screen)+J  = Choose(l)  THEN  Pointer  = 0 

3624  NEXT  I 

3626  EXIT  IF  Pointer <>0 

3628  J=J  + 1 

3630  IF  Firstjine  + J>  Lastjine  THEN 

3632  Pointeractive  = 0 

3634  Pointer  = Firstjine 

3636  END  IF 

3638  EXIT  IF  Pointer <>0 

3640  END  LOOP 

3642  ELSE 

3644  Pointer  = Firstjine 

3646  END  IF 

3648  IF  Pointeractive  THEN 

3650  IF  Pointer  = Last  line  THEN 

3652  PRINT  CHR$(1 32); 

3654  ELSE  . 

3656  PRINT  CHR$(  128); 

3658  END  IF 

3660  PRINT  TABXYd  ,Pointer);Marker$;CHR$(1 28); 

3662  END  IF 

3664  RETURN 

3666  SUBEND 
3668  I 

3670  I* * ******* 

3672  ! 

3674  SUB  Data_to_disk_r(REAL  Filed), INTEGER  Filesize,Datacount,DataJd$) 
3676  Data_to_disk_r:  I Original:  13  Nov  1984 
3678  ! Revision:  06  Aug  1987 

3680  ! This  routine  will  SAVE  data  files  on  the  disk  in  RAW  data  format. 

3682  ! Special  features: 

3684  I If  the  Diskdrive$  and/or  the  Filename$  are  null  this  routine 
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3686  ! will  prompt  the  operator  for  information.  However,  if  they 

3688  i are  not  null  it  is  assumed  that  the  program  is  supplying  the 

3690  S correct  information. 

3692  I 

3694  OPTION  BASE  1 

3696  COM  /Files/  Diskdrive$[20],Filename$n4],Ms_path$[500] 

3698  COM  /Interrupts/  INTEGER  lntr_prty 

3700  INTEGER  Local^prty.Diskspace 

3702  DIM  Ae$(5LStatus$m 

3704  REAL  Dtime 

3706  OFF  KEY 

3708  Locai_prty  = Intrprty 

3710  Dtime  = 0. 

3712  ! 

3714  ISelect  the  disk  drive  for  data  storage 

3716  I 

3718  Selectdrive:  I 

3720  IF  Diskdrive  $ « "NO  DISK"  THEN  Diskdrive!  = "" 

3722  IF  LEN(Diskdrive!)>Q  THEN  GOTO  Choosefilename 

3724  GRAPHICS  OFF 

3726  OUTPUT  2 USING  "#,K";"K" 

3728  CALL  Select  jiisk 

3730  IF  Diskdrive!  NO  DISK"  THEN  GOTO  Mistakeline 
3732  Choosefilename:  ! 

3734  IF  LEN(Filename!)  >0  THEN  GOTO  Send_tojiisk 

3736  Ac!  - "ABORT" 

3738  CALL  Enterfilename(Ac!) 

3740  IF  LEN(Filename!)  sQ  THEN  GOTO  Mistakeline 

3742  Send_to_disk:  I Create  file  and  save  information. 

3744  ON  ERROR  GOTO  Cant_savedata 

3746  Diskspace  = INT((Filesize#  1 6.0)/256)  + 2 

3748  CREATE  BOAT  Filename!&Diskdrive!,Diskspace,256 

3750  Dtime  = TIMED  ATE 

3752  DISP  " SAVING  data  in  file  ".Filename!;"  on  ".Diskdrive! 

3754  Status!  = T 

3756  ASSIGN  ©Datapath  TO  Filename!&Diskdrive! 

3758  OUTPUT  @Datapath;Status! 

3760  OUTPUT  @Datapath;DataJd!  140  chrs  description  of  data 

3762  OUTPUT  @Datapath;Datacount  Inumber  of  xy  points 

3764  OUTPUT  ©Datapath;Filessze  Isize  of  array 

3766  OUTPUT  @Datapath;FHe<#) 

3768  ASSIGN  ©Datapath  TO  * 

3770  6FF  ERROR 

3772  ! 

3774  Mistakeline:OFF  KEY 
3776  LOOP 

3778  EXIT  IF  TSMEDATE-Dtime >1.8 

3780  END  LOOP 

3782  DISP  CHR!(1 2) 

3784  OUTPUT  2 USING  "#,KB;"K" 

3786  SUBEXIT 

3788  ! 

3790  ! //////////////////////////////////////////////////////// 

3792  ! 

3794  Cant_savedata:  I 
3796  BEEP  500.. 6 
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3798 

3800 

3802 

3804 

3806 

3808 

3810 

3812 

3814 

3816 

3818 

3820 

3822 

3824 

3826 

3828 

3830 

3832 

3834 

3836 

3838 

3840 

3842 

3844 

3846 

3848 

3850 

3852 

3854 

3856 

3858 

3860 

3862 

3864 

3866 

3868 

3870 

3872 

3874 

3876 

3878 

3880 

3882 

3884 

3886 

3888 

3890 

3892 

4020 

4022 

4024 

4026 

4028 

4030 

4032 

4034 


SELECT  ERRN 

CASE  72,73,76,78,81,82,90,93 

DISP  Diskdrive$;"  has  failed  or  is  not  available  "; 

DISP  " ....CONTINUE  to  try  again." 

PAUSE 

Diskdrive  $ = "’ 

CASE  84,85 

DISP  ’ This  disk  is  not  initialized  "; 

DISP  " ....CONTINUE  to  try  again." 

PAUSE 

Diskdrive  $ = "’ 

CASE  55,64 

DISP  " This  disk  is  full,  insert  new  floppy  and/or"; 

DISP  " select  new  drive  ...CONTINUE  " 

PAUSE 

Diskdrive  $ = "" 

CASE  ELSE 
CALL  Errortrap 

IF  LEN(Filename$)>0  THEN  GOTO  Send  to_disk 
END  SELECT 
GOTO  Selectdrive 
! 

SUBEND 

! 

I 

I 

SUB  Pause_key_on 

Pause_key_on:  1 Make  sure  that  CONTINUE  key  exists. 

1 Original:  02  Dec  1 987 
I Revision:  02  Dec  1 987 
OPTION  BASE  1 
COM  /Sys/  Sys_id$[10] 

IF  Sys  id$[1,4]  = "S300"  THEN  ! reset  to  S300  system  keys 
CONTROL  KBD,15;0 
CONTROL  CRT,1 2;2 
LOAD  KEY 
END  IF 
PAUSE 

IF  Sys  id$[1,4]  = "S300"  THEN  I set  to  S200  compatible  keys 
OUTPUT  KBD  USING  "K,#";" SCRATCH  KEYX" 

CONTROL  KBD,1 5;1 
CONTROL  CRT,  12,0 
END  IF 
SUBEXIT 
SUBEND 
I 

I ***** 

! 

SUB  Errortrap 

Errortrap:  ! Original:  13  Nov  1984 
! Revision:  02  Dec  1987 
1 Trap  most  errors  here 
OPTION  BASE  1 

COM  /Files/  Diskdrive$(20],Filename${14J,Ms_path$l500] 

DIM  File$[20],Test$(256],What$(20],Ac$(5] 

BEEP  400, .6 
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4036 

4038 

4040 

4042 

4044 

4046 

4048 

4060 

4052 

4054 

4056 

4058 

4060 

4062 

4064 

4066 

4068 

4070 

4072 

4074 

4076 

4078 

4080 

4082 

4084 

4086 

4088 

4090 

4092 

4094 

4096 

4098 

4100 

4102 

4104 

4106 

4108 

41 10 

4112 

4114 

4116 

4118 

4120 

4122 

4124 

4126 

4128 

4130 


SELECT  ERRN 
CASE  54 

DISP  "DUPLICATE  FILE  NAME:  ";Filename$; 

DISP  "....PURGE  old  one?  (Y/N)"; 

LINPUT  What$ 

What$  -TRIM$(What$) 

SELECT  What$(1JJ 
CASE  "YVy" 

PURGE  Ms  _path $ &Filename $ &Diskdri ve $ 

CASE  ELSE 
Ac$  = "VALID" 

CALL  Enterfilename(Ac$) 

END  SELECT 
CASE  52,53 

DISP  "Improper  FILE  NAME  — ENTER  NEW  FILE  NAME"; 
OUTPUT  2 USING  "#,K,K";"#";Filename$ 

LINPUT  Filename  $ 

Filename  $ -TRIM$(Filename$) 

CASE  56 

DISP  "FILE:  ";Filename$;"  is  not  on  this  disk,  please  insert"; 

DISP  c correct  disk" 


DISP  "This  disk  is  full,  PLEASE  insert  dean  disk" 

CALL  PauseJcey_on 
CASE  56 

DISP  "DATA  INPUT  disk  must  be  in  drivel!  "; 

DISP  "...CONTINUE  when  ready." 

CALL  Pause_key_on 
CASE  72,73,76 

DISP  Diskdrive  $; 

DISP  " is  not  available,  type  correct"; 

DISP  " unit  specifier  (ie.  ':, 707,0')."; 

OUTPUT  2 USING  "K,#";Diskdrive$ 

LINPUT  Diskdrive$ 

CASE  80 

DISP  "CHECK  DISK  drive  door!" 

CALL  PauseJceyjan 
CASE  ELSE 

DISP  ERRM$;"  'CONTINUE'  when  fixed" 

CALL  Pause_key_on 
END  SELECT 
DISP  CHR$0  2) 

SUBEXIT 

SUBEND 
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B.3  FIXACQ 


100  I RE-STORE  "FIXACQ:,  1400" 

102  ! 

1 04  COM  /Sys/  Sys Jd  $[10] 

106  COM  /Sys  msi/  Msi  id$[20] 

108  ! 

110  OUTPUT  KBD  USING  "K,#";"SCRATCH  KEYE"  ! ERASE  SOFT  KEYS 

1 12  CONTROL  KBD,15;0!  sets  the  color  of  the  soft  keys 
114  CONTROL  KBD,2;1 
116  I 

118  I * 

1 20  ! Program  by  S.M.  Chesnut.  The  National  Institute  of  Standards 
122  1 and  Technology.  Based  on  a program  by  W.  Gans  and  R.  Stafford. 

124  ! 

1 26  Date  line:  I 

128  I * 

130  ! Last  Modified  May  17,1991  by  S.M.C 

132  ! 

134  ! 

136  ! ****** 

138  ! 

1 40  Intrjjrty  = 1 
1 42  CALL  Fixacq 
144  ! 

146  MASS  STORAGE  IS  ":,1400"!  Resets  the  mass  storage  device  to 
1 48  I the  hard  drive.  This  number  may  be 

1 50  I changed  to  suit. 

152  OUTPUT  KBD  USING  "K,#";"LOAD  KEYE"!  restore  the  typing  aid  keys 
154  PRINT  TABXY(1 ,5);"END  of  program.  So  long." 

156  ! 

158  END 
160  ! 

162  ! 

164  ! 

166  ! 

168  SUB  Fixacq 
170  ! 

1 72  Fixacq:  ! 

174  ! 

176  OPTION  BASE  1 

178  RAD 

1 80  ! This  program  reads  in  the  following  data: 

1 82  ! The  device  under  test  (DUT)  waveform,  Wave, 

1 84  ! the  voltage  calibration  data  ,Vcal, 

186  ! and  the  time  calibration  data.  Teal. 

1 88  ! The  DUT  data  is  then  "fixed"  using  the  calibration  data. 

190  ! 

192  COM  /Interrupts/  INTEGER  lntr_prty 

194  COM  /Sys_msi/  Msi_id$[20] 

196  COM /Sys/ Sys_id$[10] 

198  COM  /Bugs/  INTEGER  Bugl ,Bug2,Bug3,Printer 

200  COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

202  I 

204  Sys_id$  = SYSTEM $(" SYSTEM  ID") 

206  Msi_id$  = SYSTEM$("MSI") 

208  ! 
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210  DIM  Vcal(1 00,2), Tcal(1 00,2), Wave(4096,2) 

212  INTEGER  Datacount,Flg,Vfilesize,Tfilesize,Local_prty,StpJlg 

214  DIM  Data Jd$l40],Ch_vcal$m,Ch_tcal$(1] 

216  ! 

218  Datacount  - 32767 

220  Vfilesize-4096 

222  Tfilesize-4096 

224  Fig  -0 

226  Ch_vcal$ 

228  Chjcal$  = s" 

230  local  j5rty  = tntrprty 

232  Intrprty  - Intrprty  + 2 

234  Filenames 

236  DiskdriveS 

238  Dut:  DISP  "Input  DUT  waveform  file  name  when  prompted" 

240  WAIT  1 .0 

242  CALI  load_disk_data(Wave(*),Datacount, Data  jd$, Fig) 

244  IF  NOT  Fig  THEN 

246  BEEP 

248  DISP  "NO  FILE  IN  MEMORY,  TRY  AGAIN," 

250  WAIT  1.5 

252  GOSUB  Reset  filestuff 

254  GOTO  Dut 

256  END  IF 

258  GOSUB  Resetjilestuff 

260  REDIM  Wave{Dataeount„2) 

262  INPUT  "Is  voltage  calibration  desired?  y/n",Ch_vealS 

264  IF  Chj/calS  » BY"  OR  Ch  .vcaiS  * "y"  THEN 

266  Vcaldata:  DISP  "Input  voltage  calibration  file  name  when  prompted 

268  WAIT  1 ,0 

270  CALI  Load  disk  data(Vcal{*),Vfilesize,Datajd$, Fig) 

272  IF  NOT  Fig  THEN 

274  BEEP 

276  DISP  "NO  FILE  IN  MEMORY,  TRY  AGAIN," 

278  WAIT  1.5 

280  GOSUB  Resetjilestuff 

282  GOTO  Vcaldata 

284  END  IF 

286  GOSUB  Resetjilestuff 

288  END  IF 

290  INPUT  "Is  time  scale  calibration  desired?  y/n",Ch_tcal$ 

292  IF  ChjcalS  - "Y"  OR  ChjcalS  = V THEN 

294  Tcaldata:  DISP  "Input  time  calibration  file  name  when  prompted" 

296  WAIT  1 ,0 

298  CALL  LoadjJisk_data(Tcal(#),Tfilesize,DataJd$,Flg) 

300  IF  NOT  Fig  THEN 

302  BEEP 

304  DISP  "NO  FILE  IN  MEMORY,  TRY  AGAIN," 

306  WAIT  1.5 

308  GOSUB  Resetjilestuff 

310  GOTO  Tcaldata 

312  END  IF 

314  GOSUB  Resetjilestuff 

316  ALLOCATE  Truej(Datacount) 

318  CALL  Real_pnt  time(Tcal(*),Truej(#),Tfilesize,Datacount) 

320  END  IF 

322  ALLOCATE  Cal_wv(Datacount,2) 

324  lntr_prty  = Local_prty 
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326  IF  Ch_vcal$  = "y"  OR  Ch_vcal$  = "Y"  THEN 

328  CALL  Fix  voltage(Wave(#),Vcal(*),Datacount,Vfilesize) 

330  END  IF 

332  IF  Ch_tcal$  = "Y"  OR  Ch_tcal$  = "y"  THEN 

334  CALL  Fix  time(Wave(#),True_t(#),Calj/vv(#),Datacount,Stp_flg) 

336  ELSE 

338  MAT  Cal  wv(\1)=  Wave(*f  1) 

340  MAT  Cafwv(*,2)  = Wave(*,2) 

342  END  IF 

344  IF  NOT  Stp_flg  THEN 

346  INPUT  "Enter  a 40  character  description  of  the  data.", Data jd$ 

348  lntr_prty  = lntr_prty  + 2 

350  CALL  Data_to_disk_r(1,Datacount,Cal_wv(#),Data_id$) 

352  Localjjrty  = Intrjjrty 

354  PRINT  "End  of  program;  type  'RUN'  to  repeat." 

356  END  IF 

358  SUBEXIT 

360  Reset_filestuff:  I 

362  Diskdrive$  = "" 

364  Filename$  = "" 

366  Fig  = 0 

368  RETURN 

370  SUBEND 
372  ! 

374  I 

376  1 

378  SUB  Real  pnt  time(REAL  Tcal(#),True  t(*J, INTEGER  Tfilesize,Datacount) 
380  I 

382  Real_pnt  time:  ! 

384  ! * 

386  OPTION  BASE  1 

388  RAD 

390  I 

392  COM  /Tcal_vars/  REAL  Point, Kount,Scope_window,Real_window 

394  ! 

396  I 

398  Point =Tcal(Tfilesize,  1 Jlnumber  of  points  in  the  teal  acquisition 

400  Kount  = Tcal(Tfilesize-1 ,1  Jlnumber  of  zero  crossings  found 

402  Scope_window=Tcal(Tfilesize-2,1)!10*time  per  division 

404  Real  window  =Tcal(Tfilesize-3,1  Jlmeasured  time  window 

406  I 

408  ! find  the  "true"  time  per  point  for  points  before  the  first  teal 

410  ! interval. 

412  ! 

414  FOR  I = 1 TO  INT(Tcal(1 ,2)) 

41 6 True_t(l)  = (1-1  )*Tcal(1 , 1 )/Tcal(1 ,2) 

418  NEXT  I 

420  I 

422  1 Now  the  points  between  the  first  and  last  crossing.  This  is  the 

424  1 calibrated  portion  of  the  time  window.  All  that  comes  before 

426  I and  all  that  comes  after  the  zero  crossings  are  an  estimate  of  the 
428  I actual  time  per  point. 

430  ! 

432  FOR  J = 2 TO  Kount 

434  FOR  I = INT(Tcal(J-1 ,2))  + 1 TO  INT(Tcal(J,2J) 

436  Xy  = ri.-Tcal(J-1,2) 
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438 

440 

442 

444 

446 

448 

450 

452 

454 

456 

458 

460 

462 

464 

466 

468 

470 

472 

474 

476 

478 

480 

482 

484 

486 

488 

490 

492 

494 

496 

498 

500 

502 

504 

506 

508 

510 

512 

514 

516 

518 

520 

522 

524 

526 

528 

530 

532 

534 

536 

538 

540 

542 

544 

546 

548 


True_t(l)  = Xy#(Tcal(J,1  )-Tcal(J-1 ,1  ))/(Tcal(J,2)-Tcal(J-1 ,2))  + Tcal(J-1  f 1 ) 
NEXT  I 
NEXT  J 

I Now  the  points  after  the  final  zero  crossing  interval. 

FOR  l = INT(Tcal(Kount,2))  + 1 TO  Datacount 
Xy  = 1 „#l-Tcal(Kount,2) 

True  t(l)  — Xy  * (Real  window-Tcal(Kount,1  ))/(Point-Tcal(Kount,2))  + Tcal(Kount,1 ) 
NEXT  I 

IF  Bugl  THEN 

FOR  i = 1 TO  Datacount 
PRINT  I;"  " ;T rue  t(l) 

NEXT  I 
END  IF 
SUBEXIT 
SUBEND 
I 


SUB  Fix_voltage(REAL  WvC ),VcC),INTEGER  Datacount, Lvlsl 

I 

! Vc(1,1)»  # of  voltage  levels,  Vc(2,1)-null 
! Ve(i,1)~  measured  voltage;  2 < sj<  s levels  + 1 
I Ve(i,2)-  calibration  voltage 
! 

Fix^voltage:  S 

! 

OPTION  BASE  1 
RAD 

! 

S 

I 

J-2 
Bugl  =0 

FOR  I - 1 TO  Datacount 

IF  Bugl  THEN  PRINT  I;"  BEFORE  B;Wv(l,2); 

Temp  - Wv(I,2) 

IF  Temp<Vc(2,1)  THEN 

Wv(l,2)  =Wv(l,2)*(Vc(3,2)-Vc(2,2))/(Vc(3,1  )-Vc(2,1 )) 

END  IF 

IF  T@mp>  Vc(Lvls,1 ) THEN 

Xy  = (Wv(U)-Vc(Lvls,  1 )» * (Vc(LvlsP2)-Vc(Lvls-1 ,2)) 

Wv(If2)  = Xy/(Vc(Lv!s,  1 )-Vc(l_vis-1 , 1 ))  + Vc(Lvls,2) 

END  IF 

IF  (Temp  > = Vc(2,1)}  AND  (Temp<  = Vc(Lvls,U)  THEN 
J - Lvls 

WHILE  (Wv(l,2)<  = Vc(J,D) 

J=J-1 
END  WHILE 
Xy  = (Wv(l,2)-Vc(J,  1 )) 

A =s  (Wv(l,2)-Vc(2, 1 )) 

B = (Vc(J  + 1,1  )-Vc(J,  1 )) 

C - (Vc(J  + 1 ,2)»Vc(J,2)) 

D s (Vc(J,2)-Vc(2,2)) 

Wv(l,2)  - Xy  # (Vc(J  + 1 p2)-Vc(J,2))/(Vc(J  + 1,1  )-Vc(J,  1 )» + Vc(J,2) 
Wv(l,2)  =Wv(l,2)*(D  + Xy*(C/B))/A 
END  IF 
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550  IF  Bugl  THEN  PRINT  "AFTER  ";Wv(l,2);"VCAL";Vc(J,1 ) 

552  NEXT  I 

554  Bugl  =0 

556  SUBEXIT 

558  SUBEND 
560  ! 

562  ! 

564  ! 

566  SUB  Fix  time(REAL  Wv(#),True_t(*),Cal_wv(#), INTEGER  Datacount,Stp_flg) 

568  ! 

570  Fix  time:  I 
572  ! 

574  OPTION  BASE  1 

576  RAD 

578  l 

580  COM  /Tcal_vars/  REAL  Point, Kount,Scope_window,Realj/vindow 

582  REAL  Dt,Extrp 

584  INTEGER  Opt 

586  ! 

588  0pt  = 0 

590  I 

592  Dt~  Scope  window/Point 

594  I 

596  Cal  wv(1,1)=Wv(1,1) 

598  Cal  wv(1 ,2)  =Wv(1 ,2) 

600  Cnt  = 2 

602  J = 1 

604  WHILE  Cnt<  =Datacount 

606  Temp  = Dt  * (Cnt- 1 ) 

608  WHILE  (True„t(J)  <Temp)  AND  (J  < Datacount) 

610  J=J  + 1 

612  END  WHILE 

614  IF  J > Point  THEN  GOTO  Stpjoop 

616  Cal  wv(Cnt,1 ) =Wv(Cnt,1 ) 

618  Caiwv(Cnt,2)  = Wv(J-1 ,2)  + (Wv(J,2)-Wv(J-1 ,2))#(Temp-True_t(J-1  ))/(True_t(J)-Truej(J-1 )) 

620  IF  Bugl  THEN 

622  PRINT  Cnt;"  BEFORE  ";Wv(Cnt,2); 

624  PRINT  B AFTER  ";Calj/vv(Cnt,2) 

626  END  IF 

628  Cnt  = Cnt +1 

630  END  WHILE 

632  Stpjoop:  ! 

634  PRINT  Cnt-1  ."POINTS  CORRECTED" 

636  IF  Real_window  < (Scope_window*Dt)  THEN 

638  CLEAR  SCREEN 

640  PRINT  "The  true  time  window  is  less  than  the  scope  time  window." 

642  Select_opt:  ! 

644  PRINT  "Your  options  are  to:" 

646  PRINT  "(0)  Abort" 

648  PRINT  "(1)  Don't  correct  the  time  base" 

650  PRINT  "(2)  Correct  and  output  fewer  data  points" 

652  PRINT  "(3)  Extrapolate  using  the  last  data  point  value" 

654  PRINT  "(4)  Extrapolate  using  a value  input  from  the  keyboard  " 

656  PRINT  "(5)  Extrapolate  using  the  mean  value  of  the  last  5%  of  the  data" 

658  PRINT  "(6)  Extrapolate  using  the  mean  slope  of  the  last  5%  of  the  data" 

660  INPUT  "Your  choice  ?",Opt 
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662 

664 

666 

668 

670 

672 

674 

676 

678 

680 

682 

684 

686 

688 

690 

692 

694 

696 

698 

700 

702 

704 

705 
708 
710 
712 
714 
716 
718 
720 
722 
724 
726 
728 
730 
732 
734 
736 
738 
740 
742 
744 
746 
748 
750 
752 
754 
756  ! 
758  ! 
760  ! 
762 


Five  percent  = Cnt-1  -INT{.05  # Datacount) 

SELECT  Opt 
CASE  0 
Stp_f!g  - 1 
CASE  1 

FOR  I « 1 TO  Datacount 
Cal  wv(l,1)=Wv(l,1) 

Cal_wv«l,2)=Wv«L2) 

next! 

CASE  2 

Datacount  = Cnt-1 
CASE  3 

FOR  l = Cnt  TO  Datacount 

Cal_wv(Jf  1 ) =Cal_wv(Cnt-1 91 ) 

CaS_wv(J,2)  s=Cal_wv(Cnt-1 ,2) 

NEXT  I 
CASE  4 

INPUT  "Value  for  extrapolation?" , Extrp 
FOR  l-Cnt  TO  Datacount 
Cal_wv(l,2)  - Extrp 
Cal  wv(l,1 ) ”Wv(IJ ) 

NEXT  S 
CASE  5 
Extrp  - 0, 

FOR  I - Five  percent  TO  Cnt-1 
Extrp  - Extrp  + Cat  wv(!,2) 

NEXT  I 

Extrp  - Extrp/d-1  -Five_percent) 

FOR  S-Cnt  TO  Datacount 
Calwv(L2)  - Extrp 
Cafwvd,  1 ) = Wv(L  1 ) 

NEXT? 

CASE  6 

Extrp  = (Cal_wv(Cnt»1 ,2)-Caljwv(Fivej)ercentf2))/(Cnt-Fivej3ercent-T ) 
FOR  l-Cnt  TO  Datacount 
Cal_wv(le2)  - Extrp 
Cal  wv(l,1)-Wv(U) 

NEXT  I 
CASE  ELSE 

DISP  "That  is  not  one  of  your  choices.  Try  again." 

60X0  Select_opt 
END  SELECT 
END  IF 
Bugl  -0 
CLEAR  SCREEN 
SUBEXIT 
SUBEND 


SUB  File_menu(Mask$,Ftype$,Fls$  (^INTEGER  Fis_cntcDir_on,Prt_on) 


764  File  menu:  ! 


766  ! Original:  29  Jun  1987,  G.  Koepke 

768  I Revision:  02  Dec  1987,  07:00 

770  OPTION  BASE  1 

772  DEG 


* 
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774 

776 

778 

780 

782 

784 

786 

788 

790 

792 

794 

796 

798 

800 

802 

804 

806 

808 

810 

812 

814 

816 

818 

820 

822 

824 

826 

828 

830 

832 

834 

836 

838 

840 

842 

844 

846 

848 

850 

852 

854 

856 

858 

860 

862 

864 

866 

868 

870 

872 

874 

876 

878 

880 

882 

884 


COM  / Sys/  Sys_id$[10] 

COM  /Files/  Diskdrive${20],Filename$[14],Ms_path$[500] 

COM  /Interrupts/  INTEGER  lntr_prty 

COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

DIM  Directory  $(600)[80],Bd$(600)l7 1 ] 

DIM  D$I80],T$[51  ],lds$[40],Stat$[1  l,Test$[2561 

INTEGER  Bd_cnt,File_cnt,l,C  cnt,C0(1  ),Format  error, End  search 

IF  FIs  cnt>0  THEN  ALLOCATE  INTEGER  Choose (Fls_cnt) 

! 

I Catalog  the  disk  specified 
I 

End_search  = 0 

REPEAT  1 Generate  path  to  file  and  extract  file  name. 

ON  ERROR  GOTO  Cat_errors 
DISP  " Reading  the  Directory  ...  " 

IF  LEN(Ms_path$)>0  THEN 

MASS  STORAGE  IS  Ms_path$[1,LEN(Ms_path$)-1]&Diskdrive$ 
ELSE 

MASS  STORAGE  IS  Diskdrive$ 

END  IF 

CAT  TO  Directory $(#);NO  HEADER, COUNT  File_cnt 
OFF  ERROR 
! 

I set  up  array  of  legal  file  names. 

I 

Bd  cnt  = 0 
MAT  Bd$=  {"") 

FOR  I = 1 TO  File  cnt 

SELECT  Directory$(l)[32,36] 

CASE  Ftype$  I Ftype$  = "BDAT  - or 

I Ftype$  = "PROG  " 

IF  LEN(Mask$)>0  THEN  I Test  for  mask$ 

IF  Directory $(l)[1,LEN(Mask$)]  = Mask$  THEN 
Bd_cnt  = Bd_cnt  + 1 

Bd$(Bd_cnt)  = Directory $(l)[1  ;1 4}&"  - "&Ftype$ 

END  IF 
ELSE 

Bd_cnt  = Bd_cnt  + 1 

Bd$(Bd_cntf=  Directory  $(l)[1;14]&"  - "&Ftype$ 

END  IF 

CASE  "DIR  " I plus  all  "DIR  " listings 

Bd_cnt  - Bd_cnt  + 1 

Bd$(Bd_cnt)=  Directory $(I)[1;14]&B  - DIR  " 

CASE  ELSE 
END  SELECT 
NEXT  I 

IF  LEN (Ms_path $ ) > 0 AND  Bd_cnt>0  AND  Fls_cnt>0  THEN 
Bd_cnt  = Bd_cnt  + 1 

Bd$(Bd_cnt)  = " — - MOVE  back  up  ONE  Directory  level." 
Bd_cnt  = Bd_cnt  + 1 

Bd  $ (Bd_cnt)  = " — RETURN  to  ROOT  Directory." 

END  IF 
I 

1 set  up  file  menu 
I 

D$  = " Select  "&VAL$(Fls_cnt)&"  file  name(s)  for  data  entry." 
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886 

888 

890 

892 

894 

896 

898 

900 

902 

904 

906 

908 

910 

912 

914 

916 

918 

920 

922 

924 

926 

928 

930 

932 

934 

936 

938 

940 

942 

944 

946 

948 

950 

952 

954 

956 

958 

960 

962 

964 

966 

968 

970 

972 

974 

976 

978 

980 

982 

984 

986 

988 

990 

992 

994 

996 


T$="List  of  "&Ftype$&"files  and  DIRs  on  "&Diskdrive$ 

IF  LEN(Mask$)>0  THEN 
T$=T$&"  mask  = "&Mask$ 

END  IF 

IF  Bdjsnt>0  THEN 

IF  Dir_on>0  THEN  GOSUB  Read_datajd 
IF  Prt_on  THEN 

GOSUB  List_directory 
End^search  = 1 
ELSE 

C_ent  - FIs  jsnt 
DSSP  CHR$(1 2) 

IF  Fls_cnt  > 0 THEN 

CALL  Menu_scroll(D  $ „T$  ,Bd  $ ( * ),Bd_cnt,C_cnt, Choose!* )) 
ELSE 

CALL  Menu_scroli (D  $ , T$ , Bd  $ ! * ),Bd_cnt,C_cnt,CO (* )) 

END  IF 
I 

I transfer  file  names  to  Fis$(*L 

I 

IF  C^cnt-0  THEN  ! selection  process  aborted 
End_§earch  - 1 
MAT  Fls$  - {•") 

ELSE 

MAT  SORT  Choose!*) 

FOR  I s 1 TO  C ent 

IF  Bd$(Choose(l)H1 8,22]  -Ftype$  THEN 
Fls$(l)  = Bd$(Choose(l))[1;14] 

End_search  = 1 

ELSE  ! it  must  be  a Directory  or  message. 

SELECT  Bd$(Choose(l))[1  8,22] 

CASE  "up  ON"  I move  up  one  directory 
LOOP 

Ms_path$  = Ms_path$(1  ,LEN(Ms_path$)-1] 
EXIT  IF  LEN(Ms_path$)  =0 

Test$  = Ms_path$(LEN(Ms_path$);1] 

EXIT  IF  Test $ = "/" 

END  LOOP 

CASE  "ROOT  B ! jump  to  root  directory 
Ms_path$  = "" 

CASE  "DIR  r ! add  directory  to  Ms_path$ 

Test$  =TRIM$(Bd$(Choose(l))[1 1 1 4]) 

Ms_path$  = Ms_path$&Test$&7" 

CASE  ELSE 

DISP  "ERROR  in  directory  jump" 

PAUSE 
END  SELECT 
I - C_cnt 
END  IF 
NEXT  I 
END  IF 
END  IF 
ELSE 

DISP  " This  directory  contains  no  ";Ftype$;"  files  ...  " 

WAIT  2.5 
End^search  = 1 
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998  END  IF 

1000  DISP  CHR$(1 2) 

1002  UNTIL  End  search 

1004  SUBEXIT 

1006  Cat_errors:! 

1008  DISP  " ERROR  ...  ";ERRM$ 

1010  BEEP 

1012  CALL  Pause_key_on 

1014  DISP  CHR$0  2) 

1016  C cnt  = 0 

1018  MAT  Fls$  = ("") 

1020  SUBEXIT 

1022  ! 

1 024  I //////////////////////////////////////////////////// 

1026  ! 

1028  Read_data_id:  ! This  routine  expects  to  see  lds$  from 
1030  T GRAPH_DATA  raw  data  files. 

1 032  DISP  B Reading  file  contents  ...  Please  stand  by.  " 

1034  PRINT  TABXY(1 , 1 8);"  Reading 

1036  FOR  1 = 1 TO  Bd  cnt  ! each  BDAT  file 
1038  PRINT  TABXYd  1,18); 

1040  PRINT  USING  "3D,4A,3D,2A,#";I,"  of  ",Bd_cnt,\  " 

1042  lds$  = ”Data  not  recognized." 

1044  IF  Bd$(l)(1 8,22]  = "BDAT  " THEN 

1046  ON  ERROR  GOTO  Not_recognized 

1048  ASSIGN  @lo_path  TO  Bd$(l)[1;14] 

1050  ENTER  @lo_path;Stat$ 

1052  SELECT  Stat$ 

1054  CASE  "N" 

1056  ENTER  @lo_path;lds$ 

1058  CASE  ”Y" 

1060  lds$  = "Complete  graph  in  GRAPH  DATA  form." 

1062  END  SELECT 

1064  Not_recognized:ASSIGN  @lo_path  TO  * 

1 066  OFF  ERROR 

1068  IF  Dir_on  = 2 THEN 

1070  GOSUB  lnterpret_1 

1072  IF  Format_error  THEN  GOTO  Other  format 

1 074  GOTO  Go_on 

1076  END  IF 

1078  Other_format:l 

1080  Bd$(l)[23,71]  = " ...  "&lds$ 

1082  END  IF 

1084  Go  on:NEXT  I 

1086  "PRINT  TABXYd,  18);RPT$("  ",40); 

1088  DISP  CHR$(12); 

1090  RETURN 

1092  ! 

1 094  ! /////////////////////////////////////////////////// 

1096  ! 

1 098  lnterpret_1 : I This  is  used  to  interpret  ID  strings. 

1 1 00  Format_error  = 1 

1102  I identify  this  particular  format 

1104  RETURN 

1106  ! 

1108  ! /////////////////////////////////////////////////// 


B117 


1110  ! 

1112  List_directory:  ! This  routine  will  provide  a tabular  listing  of 
1114  ! the  directory  along  with  lds$  if  provided 

1116  ! 

1118  DISP  " Listing  directory  ...  " 

1120  ON  TIMEOUT  7,10  GOTO  Printer Jcaput 
1 1 22  PRINTER  IS  Printer 

1124  PRINT  USING  7/" 

1 1 26  PRINT  T$ 

1128  IF  LEN (Ms_path $ 1 > 0 THEN  PRINT  "HPS  Path:  ";Ms_path$ 

1130  PRINT  RPT$(*“",80) 

1132  PRINT  "File  name"; 

1134  IF  Dir  on  THEN 

1 1 36  PRINT  " - TYPE  ...  contents" 

1 1 38  ELSE 

1140  PRINT"  - TYPE" 

1142  END  IF 

1144  PRINT  RPT$r-",80) 

1146  FOR  I - 1 TO  Bd_cnt 

1148  IF  Bd$|l)|1 8,22J -Ftype$  OR  Bd$(l)t1 8.221  - "DIR  " THEN 

1150  PRINT  Bd$ (II 

1152  END  IF 

1 1 §4  NEXT  I 

1156  PRINT  RPT$rj\80) 

1 1 58  PRINT 

1 1 60  PRINTER  IS  CRT 

1162  OFF  TIMEOUT  7 

1 1 64  RETURN 

1166  Printer Jcaput:  DISP  " Printer  not  responding  ...  listing  aborted.  " 

1168  BEEP 

1170  WAIT  1.8 

1172  OFF  TIMEOUT  7 

1174  RETURN 

1176  SUBEND 

1178  ! 

1180  ! *********** ****** 

1182  I 

1 1 84  SUB  Select_disk 
1 1 86  Selectjdisk:  I Original:  1 3 Nov  1 984 
1188  I Revision:  02  Dec  1 987 

1 1 90  OPTION  BASE  1 

1 1 92  COM  /Files/  Diskdrive$[20LFilename$n  4],Ms_path$[500] 

1194  COM  /Interrupts/  INTEGER  lntr_prty 

1 196  COM  /Sys_msi/  Msijd$ 

1198  COM  /Sys/  Sys_id$ 

1200  INTEGER  local_prty„Dd,Pt,ChooseO ) 

1202  DIM  Disc$(30)[601,Title$[40],Displ$(601 

1 204  Local_prty  = Intr_prty 

1 206  OFF  KEY 

1208  1 

1210  I Define  the  disk  drives  available  for  this  system,  reserve  the 

1212  ! first  characters  for  the  drive  address  and  the  characters  after 

1214  ! the  - for  a description  of  the  drive. 

1216  I 

1218  I Example: 

1 220  I Disc$(1 ) = 700,0,0  HP  91 33H  HARD  disk,  volume  0.K 
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1222 

1224 

1226 

1228 

1230 

1232 

1234 

1236 

1238 

1240 

1242 

1244 

1246 

1248 

1250 

1252 

1254 

1256 

1258 

1260 

1262 

1264 

1266 

1268 

1270 

1272 

1274 

1276 

1278 

1280 

1282 

1284 

1286 

1288 

1290 

1292 

1294 

1296 

1298 

1300 

1302 

1304 

1306 

1308 

1310 

1312 

1314 

1316 

1318 

1320 

1322 

1324 

1326 

1328 

1330 

1332 


! 

! 

Displ$  = " SELECT  DISK  DRIVE  ...  Abort  will  cancel.  " 

Title$  = " Available  disk  drives  for  this  system.  " 

Pt  = 1 I allow  only  one  select 
! 

IF  Diskdrive$[1 ,1]  < THEN  Diskdrive  $ = "" 

IF  Msi  id$(1,1]<  THEN  Msi  id$  = SYSTEM  $("  MSI") 

IF  Msi”id$[1,1]<  THEN  I Must  be  HFS  subdirectory 

Ms_path$  = Msi  id$(1,POS(Msi  id$,":")-1)  ! strip  off  subdirs 
IF  Ms_path$[LEN(Ms  path$);1]<  >"/"  THEN  Ms_path$  =Ms_path$&"/" 
Msi  id$  = Msijd$[POS(Msi  id$,":"),LEN(Msi_id$)] 

END  IF” 

Diskdrive  $ - TRIM  $ (Diskdrive  $) 

Msi  id$  =TRIM$(Msi  id$) 

IF  LEN (Diskdrive $ ) > 0 AND  LEN(Msi_id$)>0  THEN 
Disc  $ ( 1 ) = Diskdrive  $ &RPT$  ("  " , 1 7-LEN(Diskdrive  $ ) ) 

Disc$(1)  = Disc$(1)&"-  Last  selected  disk  drive." 

Dd  = 1 

IF  Diskdrive$  < >Msi  id$  THEN 

Disc$(2)  = Msijd$&RPT$("  ",1 7-LEN(Msi_id$)) 

Disc$(2)  = Disc$(2)&"-  Start-up  mass  storage  unit  specifier." 

Dd  = Dd  + 1 
ELSE 

Disc$(1 ) = Disc$(1  )&"  Start-up  MSUS." 

END  IF 
ELSE 

IF  LEN(Msi_id$)>0  THEN 

Disc$(1 ) = MsiJd$&RPT$("  ",1 7-LEN(Msi_id$)) 

Disc$(1)  = Disc$(1)&"-  Start-up  mass  storage  unit  specifier." 

Dd  = 1 
ELSE 
Dd  -0 
END  IF 
END  IF 
Disk:  ! 

! customize  system  drives  here 

! Follow  format  with  - after  unit  specifier,  description  is 
I optional  but  recommended. 


Disc$(Dd  + 1)  = ":, 702,0 
Disc$(Dd  + 2)  - ":,702,1 
Disc$(Dd  + 3)  = 703,0 

Disc$(Dd  + 4)  = 1 400 

I 


- HP  9122  dual  microfloppy  left  drive" 

- HP  9122  dual  microfloppy  right  drive" 

- HP  9125  single  5.25  floppy  drive" 

- HP  9133H  hard  disk  volume  1" 


Dd  = Dd  + 4 ! add  the  number  of  drive  specifiers  above 

! 


IF  Sys_id$(1 ,4]  < > "S300"  THEN 

Disc$(Dd  + 1 ) = ":,4,1  ~ LEFT  internal  series  200" 

Disc$(Dd  + 2)  = ":,4,0  - RIGHT  internal  series  200" 

Dd  = Dd  + 2 
END  IF 


CALL  Menu_scroll(Displ$,Title$,Disc$(*),Dd,Pt,Choose(#)) 
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1334 

1336 

1338 

1340 

1342 

1344 

1346 

1348 

1350 

1352 

1354 

1356 


IF  Pt  ~0  THEN 

Diskdrive$  = "NO  DISK" 


ELSE 

Dd  = POS(Disc$(Choose(Pt)),"-"H  I find  - 
IF  Dd>5  THEN  I valid  msus 


Diskdrive  $ =TRIM$(Disc$(Choose(Pt))[1  ,Dd]) 
ELSE 


Diskdrive$  = "NO  DISK" 
END  IF 


DISP  " ERROR  in  reading  MSUS  from  string,  - chr  not  found. 
BEEP 

CALL  Pause_key_on 


1358  END  IF 

1 360  Diskselected:OFF  KEY 
1362  SUBEXIT 

1364  SUBEND 
1366  ! 

1368  ! * **««#«*«****<»««#.*..« 

1370  ! 

1372  SUB  Enterfilename(Ac$) 

1 374  Enterfilename:  I Original:  1 3 Nov  1 984 

1376  I Revision:  10  Dec  1990  includes  HFS  directories 

1378  OPTION  BASE  1 

1380  COM  /Files/  Diskdrive$[20],Fiiename$[14],Ms_path$l500] 

1382  COM  /Interrupts/  INTEGER  lntr_prty 

1 384  INTEGER  8, Ascii_num„Maskflag, Namelength 

1386  DIM  Test${256LHfsjemp$[161] 

1388  Namelength  * 1 0 

1390  IF  LEN(Ms_path$)>0  THEN  OUTPUT  KBD  USING  "K,#";"#"&Ms„path$&"H“ 

1392  DISP  " ENTER  HFS  directory  PATH  (no  file)"; 

1 394  IF  Ac$  < > "PATH"  THEN 

1 396  DISP  ",  ENTER  / for  HFS  ROOT  or  null  for  LIF..."; 

1398  END  IF 

1400  LINPUT  Hfsjemp$ 

1 402  Hf  s_temp  $ = TRIM  $ (Hf  s Jemp  $ ) 

1404  IF  LEN(Hfs_temp$)  >0  THEN 

1406  IF  LEN(Hfs_temp$)>  1 AND  Hfs  temp $[LEN(Hfs__temp$);1]<  >"/"  THEN 

1 408  Hfs_temp$  = Hfs_temp$&"/" 

1410  END  IF 

1412  IF  LEN(Hfs_temp$)  = 1 THEN  Hfs_temp$  = "" 

1414  Namelength  = 14 

1416  END  IF 

1418  IF  Ac$  = " PATH"  THEN 

1420  Ms_path  $ = Hf  s_temp  $ 

1422  SUBEXIT 

1424  END  IF 

1426  IF  LEN(Filename$)>0  THEN  OUTPUT  KBD  USING  "K,#";"#"&Filename$&"H" 

1428  Efn:  I 

1430  DISP  " ENTER  the  FILE  NAME  ... 

1432  SELECT  Ac  $ 

1434  CASE  "CAT- 

1436  DISP  ° (ENTER  CAT  mask*  or  ENTER  null  to  CAT)"; 

1438  CASE  " ABORT- 

1440  DISP  "(ENTER  null  to  ABORT) 

1442  CASE  "VALID" 

1444  DISP  "(must  be  a VALID  namel) 
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1 446  END  SELECT 

1 448  LINPUT  Test$ 

1450  Test$=TRIM$(Test$) 

1452  IF  LEN(Test$)  = 0 AND  Ac$  = "VALID"  THEN  GOTO  Enterfilename 
1 454  IF  LEN(Test$)  =0  THEN  Abortline 

1456  IF  LEN(Test$)>Namelength  THEN 

1458  BEEP 

1460  DISP  "ERROR  in  NAME  ENTRY  - max  ";Namelength;"  chars,  you  have  "; 

1462  DISP  LEN(Test$);"  " 

1464  WAIT  1.8 

1466  OUTPUT  2 USING  "K,#";"#"&Test$&"H" 

1468  GOTO  Efn 

1470  END  IF 

1472  IF  POS(Test$,"*")>  1 THEN 

1474  Test$=Test$[1,POS(Test$,"*")-1] 

1476  Maskflag  = 1 

1478  ELSE 

1480  Maskflag=0 

1482  END  IF 

1 484  FOR  I a*  1 TO  LEN(Test$) 

1486  Ascii_num  = NUM(Test$[ll) 

1488  SELECT  Asciijuim 

1 490  CASE  65  TO  90,95,97  TO  1 22,48  TO  57 

1492  (Allowed  characters 

1494  CASE  ELSE 

1 496  BEEP 

1498  DISP  "ERROR  in  NAME  ENTRY-ILLEGAL  CHARACTERS,  TRY  AGAIN." 

1500  WAIT  1.8 

1502  OUTPUT  2 USING  "K,#";"#"  &Test$&"H" 

1 504  GOTO  Efn 

1 506  END  SELECT 

1508  NEXT  I 

1510  IF  Maskflag  THEN 

1512  Filename$  =Test$&"#" 

1514  ELSE 

1516  Filename$  =Test$ 

1518  END  IF 

1520  Ms_path$  =Hfs_temp$ 

1 522  SUBEXIT 

1 524  Abortline:Filename$  = "" 

1526  IF  Ac$  = "CAT"  THEN  Ms_path$  =Hfs_temp$ 

1528  SUBEXIT 

1530  SUBEND 
1532  ! 

-j  £34  | ***#*e#e*ee****#*##*#*e*e*«**e#e****##*#*#*»**#******»****** 

1536  ! 

1538  SUB  Menu_scroll(D$,T$,ltems$(*), INTEGER  ltem_cnt,To_select,Choose(*)) 

1540  Menu_scroll:l  Original:  22  Jun  1987,  Galen  Koepke,  NBS  723.04 
1542  ! Revision:  22  Aug  1990,  12:00,  Dennis  Camell 

1544  ! 

1 546  1 A general  purpose  menu  utility  for  scrolling  items  and 

1 548  ! selecting  either  a fixed  number  or  a random  number 

1550  ! of  items. 

1552  ! for  fixed  : To_se!ect  > 0 

1554  ! for  random  : To_select  = *1 

1 556  I The  items  are  arranged  in  screens  of  1 5 items  each  and 
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1558  ! the  user  may  access  screens  via  softkeys.  There  may  be 

1560  ! up  to  40  screens  or  600  items  to  choose  from. 

1562  ! Maximum  sizes:  D$[80],  T$[51],  ltems(*)[70] 

1564  ! Items${*)  contains  the  item  descriptions 

1566  ! Itemcnt  is  the  number  of  items  in  ltems$(#) 

1568  ! Choose(*  I is  dimensioned  to  the  number  of  required  choices 

1 570  ! and  will  be  filled  with  the  item  numbers  chosen. 

1572  ! To_select  is  the  number  of  required  choices. 

1574  I 

1576  OPTION  BASE  1 

1578  PRINTER  IS  CRT 

1580  DEG 

1582  GOSUB  Def_variables 

1584  GOSUB  Define_screens 

1 586  GOSUB  Make_selections 

1 588  IF  Nuli  jile  THEN  I reset  to  zero 

1590  ltem_cnt  = 0 

1592  ltems$(1)  = B" 

1594  To_seleet  = 0 ! no  valid  selections 

1596  END  IF 

1598  SUBEXIT 

1600  S 

1 602  I //////////////////////////////////////////////////// 

1604  I 

1606  Def_variables:l 

1608  COM  /Interrupts/  INTEGER  Intr  prty 

1610  COM  /Bugs/  INTEGER  Bug  1 sBug2tBug3, Printer 

1612  COM  /Sy s/  Sy s Jd  $ (1 0] 

1614  I 

1616  INTEGER  Screen_cntltems_per_scn,FirstJtem(40),LastJtem(40) 

1618  INTEGER  LJ(KcFirstJinetLastJineeActive_screenfPointer,Last_pt 

1 620  INTEGER  local_prtyfSkipstKnobcountfPointeractive,KO,Null_file 

1622  INTEGER  Exit_flag,TempfRandom_select(lndx 

1624  DIM  Marker$[8]fTest$[256] 

1626  ! 

1628  I initialize  parameters 

1630  ! 

1 632  Local_prty  = lntr_prty 

1 634  IF  LocaLprty  < 1 THEN  LocaljDrty  = 1 0 

1636  IF  LEN(Sys_id$)  =0  THEN  Sys_id$  - SYSTEM $(" SYSTEM  ID") 

1638  IF  ltem_cnt<1  THEN 

1 640  Null  Jile  = 1 

1 642  ltem_cnt  - 1 

1644  To  select  = 0 

1646  ltems$(1)  = B##*  Empty 

1 648  ELSE 

1650  Nulljile  = 0 

1652  END  IF 

1654  IF  Tojselect  = -1  THEN 

1656  Random_select  = 1 I choose  random  number  of  items 

1658  To  select-0  I needed  for  softkeys 

1660  END  IF 

1662  IF  To_select>ltem_cnt  THEN  To_select  = ltem_cnt 

1664  MAT  “Choose  = (999) 

1666  Skips -0 

1668  Knobcount  = 0 


1670  Doneflag=0 

1672  Marker$  = " = = = >"&RPT$(CHR$(8),4) 

1 674  RETURN 

1676  ! 

1 678  ! //////////////////////////////////////////////////// 

1680  ! 

1 682  Define  screens:!  Set  up  screens  of  1 5 items  each. 

1684  ! 

1686  ltems_per_scn  = 1 5 ! Maximum  number  of  dispiayable  items 

1688  IF  INT(ltem_cnt/ltems_per_scn)  = ltern_cnt/ltems_per_scn  THEN 

1690  Screen  cnt  = INT(ltem  cnt/ltems_per  sen) 

1692  ELSE 

1 694  Screen_cnt  = INT(ltem_cnt/ltems  per_scn)  + 1 

1696  END  IF 

1698  J = 1 

1 700  FOR  ! = 1 TO  Screen_cnt  ! set  up  each  screen 
1702  FirstJtem(l)=J 

1 704  IF  J + ltems_per_scn-1  < ltem_cnt  THEN 

1 706  Lastjtem(l)  = J + !tems_per_scn-1 

1708  J = J + ltems_per_scn 

1710  ELSE 

1712  Last  item(i)  = !tem_cnt 

1714  END  IF 

1716  NEXT  I 

1718  RETURN 

1720  ! 

1722  ! /////////////////////////////////////////////////// 

1724  ! 

1726  Make_selections:!  MENU  setup  and  use. 

1728  Active_screen  * 1 ! first  screen  is  active 

1730  First Jine  = 2 ! first  printed  line  on  screen  = 2 or  greater. 

1732  GOSUB  Write_screen  ! activate  screen  at  Active_screen 

1734  I and  set  First  Jine  and  Last  Jine  for  Pointer 

1736  I write  Marker$  to  first  non-selected  line. 

1738  K0  = 0 I Keys  start  at  zero 

1740  Exit_flag=0  ! allow  ENTER  key  to  exit  when  selections  filled. 
1742  Key Joop:  ! 

1744  ON  KBD,Local_prty  GOSUB  Processjcbd 

1746  ON  KNOB  .01  ,Local_prty  GOSUB  Move_pointer 

1748  IF  Random_select  THEN 

1750  ! set  keys  for  random  selection 

1752  DISP  D$ 

1754  ON  KEY  KO  LABEL  " Select",  Local  jjrty  GOSUB  Select_random 

1756  ON  KEY  KO  + 9 LABEL  " Accept" ,Local_prty  GOTO  Exitjine 

1758  ELSE  ! set  key  KO  for  fixed  selection 

1 760  IF  Skips  <To_select  THEN 

1762  DISP  D$ 

1764  IF  To _select  > 1 THEN 

1 766  Test$  = " Select  "&VAL$(Skips  + 1 )&"  of  "&VAL$(To_select) 

1768  ELSE 

1770  Test$  = " Select" 

1772  END  IF 

1774  ON  KEY  KO  LABEL  Test$,Local_prty  GOSUB  Select_fixed 

1776  ELSE 

1778  IF  To_select>0  THEN 

1780  DISP  " Selection  process  complete  ..." 
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1782  ELSE 

1784  DISP  " Menu  for  information  only  ...  " 

1786  END  IF 

1788  ON  KEY  KO  LABEL  " Accept", Local_prty  GOTO  Exitjine 

1790  END  IF 

1792  END  IF 

1794  IF  Active_screen < Screen _cnt  THEN 

1796  ON  KEY  KO  + 1 LABEL  " Next  Screen  ".LocaLprty  GOSUB  Next  screen 

1798  ELSE 

1800  OFF  KEY  K0+  1 

1 802  END  IF 

1 804  IF  Active_screen  > 1 THEN 

1806  ON  KEY  KO  + 2 LABEL  " Last  Screen", Local^prty  GOSUB  Last_scr@en 

1808  ELSE 

1810  OFF  KEY  KO  + 2 

1812  END  IF 

1814  IF  Skips  >0  OR  Randomselect  THEN 

1816  ON  KEY  KQ  + 3 LABEL  " Reset  Select",Local_prty  GOSUB  Select_/eset 

1818  ELSE 

1820  OFF  KEY  KO  + 3 

1822  END  IF 

1824  IF  To  select  >0  OR  Random  select  THEN 

1826  ON  KEY  KO  + 4 LABEL  " Abort  BffLocatprty  GOTO  Escapejine 

1828  ELSE 

1830  OFF  KEY  KO  + 4 

1832  END  IF 

1834  IF  Screen_cnt>2  THEN 

1836  ON  KEY  KO  + 6 LABEL  "Jump  to  Screen \Local_prty  GOSUB  Jump_to_scn 

1838  ELSE 

1 840  OFF  KEY  KO  + 6 

1 842  END  IF 

1 844  IF  Exit  .flag  THEN  Exitjine 

1 846  GOTO  Keyjoop 

1 848  Escape  line:Skips  ”0 

1850  MAT  Choose-  (01 

1852  To_select-0 

1 854  ExitJine:OFF  KEY 

1856  “MAT  SORT  Chooser) 

1858  OFF  KNOB 

1860  OFF  KBD 

1862  OUTPUT  KBD;CHR$(255)&CHR$(75); 

1864  PRINT  CHR$(1 28); 

1 866  I everything  cleared,  now  go  back  to  work. 

1868  RETURN 

1870  I 

1 872  I /////////////////////////////////////////////////// 

1874  l 

1876  Next_screen:  I 

1878  OFF  KBD 

1880  OFF  KNOB 

1882  OFF  KEY 

1884  IF  Active_screen  = Screenjsnt  THEN  RETURN 

1886  Active_screen  --  Active_screen  + 1 

1 888  GOSUB  Write_screen 

1890  RETURN 

1892  ! 
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1 894  ! /////////////////////////////////////////////////// 

1896  I 

1898  Last_screen:  ! 

1900  OFF  KBD 

1902  OFF  KNOB 

1904  OFF  KEY 

1 906  IF  Active_screen  = 1 THEN  RETURN 

1 908  Active_screen = Active_screen- 1 

1910  GOSUB  Write_screen 

1912  RETURN 

1914  ! 

1916  ! ////////////////////////////////////////////////// 

1918  ! 

1 920  Jump  to  errors:DISP  " Not  a valid  screen  number  ...  try  again.  " 

1922  BEEP 

1924  WAIT  1.8 

1 926  Jump  to  sen:  I 

1 928  OFF~KBD 

1930  OFF  KNOB 

1932  OFF  KEY 

1934  DISP  " ENTER  the  screen  number  desired  (1  to  ";Screen  cnt;"h" 
1936  LINPUT  Test$ 

1938  Test$  =TRIM$(Test$) 

1940  IF  LEN(Test$)  = 0 THEN  Jump_to_return 
1 942  ON  ERROR  GOTO  Jump_to_errors 

1944  Temp  = INT(VAL(Test$)} 

1 946  OFF  ERROR 

1 948  IF  Temp  < 1 OR  Temp  > Screen_cnt  THEN  Jump_to_errors 

1950  Active_screen = Temp 

1 952  GOSUB  Write_screen 

1 954  Jump_to  return:  ! 

1956  DISPCHR$(12) 

1958  Test$  = "" 

1 960  RETURN 

1962  ! 

1 964  I ////////////////////////////////////////////////// 

1966  ! 

1968  Select_fixed:l 

1970  OFF  KBD 

1972  OFF  KNOB 

1974  OFF  KEY 

1976  IF  NOT  Pointeractive  THEN 

1978  DISP  "NO  additional  selections  for  this  screen." 

1 980  BEEP 

1 982  WAIT  2 

1984  DISP  CHR$(12); 

1986  RETURN 

1988  END  IF 

1990  IF  Skips  = To  select  THEN 

1 992  IF  To_select  = 0 THEN 

1994  DISP  "This  menu  is  for  information  only,"; 

1996  DISP  " no  selection  allowed." 

1998  ELSE 

2000  DISP  "All  selections  have  been  filled,"; 

2002  DISP  " 'Select  Reset'  to  repeat." 

2004  END  IF 
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2006 

2008 

2010 

2012 

2014 

2016 

2018 

2020 

2022 

2024 

2026 

2028 

2030 

2032 

2034 

2036 

2038 

2040 

2042 

2044 

2046 

2048 

2050 

2052 

2054 

2056 

2058 

2060 

2062 

2064 

2066 

2068 

2070 

2072 

2074 

2076 

2078 

2080 

2082 

2084 

2086 

2088 

2090 

2092 

2094 

2096 

2098 

2100 

2102 

2104 

2106 

2108 

2110 

2112 

2114 

2116 


BEEP 
WAIT  2 

DISP  CHR$(1 2); 

RETURN 
END  IF 

Skips  - Skips  + 1 

Choose(Skips)  ~ FirstJtem(Active_screen)  + Pointer-Firstjine 

PRINT  CHR$(129);  ! inverse  video 

PRINT  TABXY(10,Pointer);ltems$(Choose(Skips)) 

PRINT  CHR$(128); 

PRINT  TABXY(1, Pointer); 

SELECT  Pointer 
CASE  Firstjine 

GOSUB  Point_forward 
CASE  Lastjine 

GOSUB  Point  backward 
CASE  ELSE 

I move  forward  unless  it  requires  wrapping  to  beginning. 
IF  Skips- 1 >0  THEN  S check  for  selected  items. 


I - Pointer-Firstjine 


IF  FirstjtemiActive_  screen?  + I - Choosey ) THEN  K~1 
NEXT  J 
EXIT  IF  K=G 
1 = 1 + 1 

IF  I + Firstjine  > Lastjine  THEN  K = ~1 
EXIT  IF  K = -1 
END  LOOP 
IF  K=0  THEN 

GOSUB  Pointjorward 
ELSE 

GOSUB  Point^backward 
END  IF 
ELSE 

GOSUB  Point  forward 
END  IF 
END  SELECT 
RETURN 

I 

I ////////////////////////////////////////////////// 

! 

Select  ^random:! 

OFF  KBD 
OFF  KNOB 
OFF  KEY 
Test$  = "NO" 

IF  NOT  Pointeractive  THEN 

DISP  “NO  additional  selections  for  this  screen.* 


DISP  CHR$(1 2); 
RETURN 
END  IF 

FOR  1-1  TO  To  select 
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2118 

2120 

2122 

2124 

2126 

2128 

2130 

2132 

2134 

2136 

2138 

2140 

2142 

2144 

2146 

2148 

2150 

2152 

2154 

2156 

2158 

2160 

2162 

2164 

2166 

2168 

2170 

2172 

2174 

2176 

2178 

2180 

2182 

2184 

2186 

2188 

2190 

2192 

2194 

2196 

2198 

2200 

2202 

2204 

2206 

2208 

2210 

2212 

2214 

2216 

2218 

2220 

2222 

2224 

2226 

2228 


IF  Choose(l)  = FirstJtem(Active_screen)  + Pointer-First_line  THEN 
lndx  = l 

Test$  = "YES" 

END  IF 
NEXT  I 

SELECT  Test$ 

CASE  "YES"  I Selected  item  is  tagged  ...  untag 

IF  Pointer  < > LastJtem(Active_screen)  + 1 AND  Pointer  < >17  THEN 
PRINT  CHR$(128);I  normal  video 
ELSE 

PRINT  CHR${132);I  underline  video 
END  IF 

PRINT  TABXY(  1 0,Pointer);ltems$  (Choose(lndx)) 

FOR  l = lndx  TO  To_select-1 
Choose(l)  = Choose(l  + 1 ) 

NEXT  I 

ChoosefT  o_select)  = 999 
T o_select = T o_se!ect- 1 

CASE  "NO"  I Selected  item  is  untagged  ...  tag  it 

To_select=To_select+ 1 

Choose(To_select)  = First_item(Active_screen)  + Pointer-Firstjine 
IF  Pointer <> Last  item(Active  screen) + 1 AND  Pointer<  > 1 7 THEN 
PRINT  CHR$(129);I  inverse~video 
ELSE 

PRINT  CHR$(133);I  inverse  video  with  underline 
END  IF 

PRINT  T ABXY ( 1 0,Pointer);ltems  $ (Choose(T o_select) ) 

END  SELECT 
PRINT  CHR$(1 28); 

PRINT  TABXYd, Pointer); 

RETURN 

I 

I ////////////////////////////////////////////////// 

I 

Select_reset:  IClear  Choose  file 

OFF  KBD 
OFF  KNOB 
OFF  KEY 

IF  Random_select  THEN  To_select  = 0 
Skips  = 0 

MAT  Choose  = (999) 

GOSUB  Write_screen 
RETURN 
1 

I ///////////////////////////////////////////////// 

! 

Process_kbd:l  Allow  use  of  arrows  and  enter  key  in  addition  to  soft. 

Test$  = KBD$ 

IF  LEN(Test$)  = 1 AND  Test${1,1]<  >CHR$(32)  THEN 
BEEP  80.,. 1 
RETURN 
END  IF 

IF  Test$[1 ,1]  = CHR$(32)  THEN  GOSUB  Point_forward 
IF  Test$[1,1]<  >CHR${255)  THEN  RETURN 
SELECT  Test$[2,2) 

CASE  CHR$(255) 
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2230 

2232 

2234 

2236 

2238 

2240 

2242 

2244 

2246 

2248 

2250 

2252 

2254 

2256 

2258 

2260 

2262 

2264 


CASE  "EVsVtV&" 

IF  Random  select  THEN 


CASE  "WT" 

GOSUB  Point_forward 


CASE  "AVW" 

GOSUB  Point_backward 


Exit_flag  ™ 1 
END  IF 
END  IF 
CASE  ELSE 


GOSUB  Select_random 
ELSE 


BEEP  80.,.  1 


IF  Skips  <To_select  THEN 


GOSUB  Select_fixed 
ELSE 

! exit  routine 


l do  nothing 


2266  END  SELECT 

2268  Test$ 

2270  RETURN 

2272  I 

2274  I ////////////////////////////////////////////////// 

2276  I 

2278  Point_forward:Knobeount~5 
2280  GOSUB  Move_pointer 

2282  RETURN 

2284  Point_backward:Knobcount  = =5 
2286  GOSUB  Move_pointer 

2288  RETURN 

2290  ! 

2292  1 ////////////////////////////////////////////////// 

2294  I 

2296  Jog_pointer:l  Move  the  selection  pointer  on  the  active  screen. 

2298  ! without  regard  to  selected  values 

2300  IF  Knobcount>0  THEN  1 Move  forward 

2302  Pointer  - Pointer  + 1 

2304  ELSE  ! Move  backward 

2306  Pointer  = Pointer- 1 

2308  END  IF 

2310  IF  Pointer  < First Jine  THEN  Pointer  = Lastjine 

2312  IF  Pointer  > Last  Jine  THEN  Pointer  = First  Jine 

2314  RETURN 

2316  ! 

2318  I ///////////////////////////////////////////////////////// 

2320  ! 

2322  Move_pointer:l  Control  pointer  to  avoid  re-selection  of  items 

2324  IF  NOT  Pointeractive  THEN  RETURN  I No  selections  to  be  made. 

2326  Knobcount  = Knobcount  + KNOBX-KNOBY 

2328  IF  ABS(Knobcount)  < 4 THEN  RETURN 

2330  Last_pt  = Pointer 

2332  GOSUB  Jog_pointer 

2334  IF  Skips >0  THEN 

2336  LOOP 

2338  J = Pointer-Firstjine 

2340  FOR  I = 1 TO  Skips 
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2342 

2344 

2346 

2348 

2350 

2352 

2354 

2356 

2358 

2360 

2362 

2364 

2366 

2368 

2370 

2372 

2374 

2376 

2378 

2380 

2382 

2384 

2386 

2388 

2390 

2392 

2394 

2396 

2398 

2400 

2402 

2404 

2406 

2408 

2410 

2412 

2414 

2416 

2418 

2420 

2422 

2424 

2426 

2428 

2430 

2432 

2434 

2436 

2438 

2440 

2442 

2444 

2446 

2448 

2450 

2452 


IF  First Jtem(Active_screen)  + J = Choose(l)  THEN  J = 999 
NEXT  I 

IF  J = 999  AND  Pointer  = Last_pt  THEN  Pointeractive  = 0 
EXIT  IF  Pointeractive=0 

IF  J = 999  THEN  GOSUB  Jog  pointer 
EXIT  IF  Jo 999 
END  LOOP 
END  IF 

Knobcount  = 0 

OUTPUT  KBD;CHR$(255)&CHR$(84);  I Bring  screen  home 
IF  Last_pt  = Last  line  THEN  PRINT  CHR$(132); 

PRINT  " "; 

IF  Pointeractive  THEN  ! Pointer  active 
IF  Pointer  = Last  line  THEN 
PRINT  CHR$(1 32); 

ELSE 

PRINT  CHR$(1 28); 

END  IF 

PRINT  TABXYd  ,Pointer);Marker$;CHR$d 28); 

END  IF 
RETURN 
! 

! ////////////////////////////////////////////////// 

I 

Write_screen:l  Write  the  screen  pointed  to  by  Active^screen 
I home  and  clear  screen 

OUTPUT  KBD;CHR$(255)&CHR$(84)&CHR$(255)&CHR$(75); 
Knobcount  = KNOBX-KNOBY  I Clear  knob  and  keyboard 
Knobcount  = 0 
Test$  = KBD$ 

Test$  = "" 

I 

PRINT  TABXYd fFirstJine-1);CHR$(1 32);"  Item  #|  Screen  #"; 

PRINT  USING  "#,2Df4Af2D,3A";Active_screen,"  of  ";Screen_cnt;"  j B 
PRINT  T$;RPT$("  ",51 -LEN(T$)); 

PRINT  TABXY(80, First  lined );"  | ";CHR$(1 28); 

J = 0 
REPEAT 

IF  J = LastJtem(Active_screen)-Firstjtem(Active  screen)  THEN 
PRINT  CHR$(1 32);“ 

PRINT  TABXYd , First  line  + J);RPT$("  ",80) 

ELSE 

PRINT  CHR$(1 28); 

END  IF 

PRINT  TABXY(5,FirstJine  + J); 

PRINT  USING  "3D,Af#";First_item(Active__screen)  + J,"  j " 

IF  Random_select  THEN 
FOR  1 = 1 TO  To_select 

IF  First_item(Active_screen)  + J =Choose(l)  THEN 
PRINT  CHR$(1 29); 

END  IF 
NEXT  I 
ELSE 

IF  Skips  >0  THEN  I make  this  line  inverse  video 
FOR  I = 1 TO  Skips 

IF  First jtem(Active_screen) +J  =Choose(l)  THEN 
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2454  PRINT  CHR$(1 29); 

2456  END  IF 

2458  NEXT  I 

2460  END  IF 

2462  END  IF 

2464  PRINT  TABXYO  0,First_line  + J);ltems$(FirstJtem(Active_screen)  + J) 

2466  PRINT  TABXY(80, First Jine  + J);"  |"; 

2468  J=J  + 1 

2470  UNTIL  J > = (LastJtem(Active_screen)-FirstJtem(Active_screen)  + 1 ) 
2472  Lastjine  = LastJtem(Active_screen)-FirstJtem(Active_screen) 

2474  Lastjine  = Lastjine  + First Jine 

2476  I 

2478  I set  marker  to  first  non-selected  item. 

2480  I 

2482  Pointeractive  = 0 

2484  IF  To_seSeet>0  OR  Randorn_select  THEN  Pointeractive  - 1 

2486  IF  Skips  >0  AND  Pointeractive  = 1 THEN  I find  first  non-selected  item 

2488  J-0 

2490  LOOP 

2492  Pointer  - First  Jine  + J 

2494  FOR  I * 1 TO  Skips 

2496  IF  First  item  (Active  screen)  + J -Choose(l)  THEN  Pointer  -0 

2498  NEXT  8 

2500  EXIT  IF  Pointer  < >0 

2502  J=J  + 1 

2504  IF  Firstjine  + J>  Lastjine  THEN 

2506  Pointeractive  = 0 

2508  Pointer  = First  Jine 

2510  END  IF 

2512  EXIT  IF  Pointer <>0 

2514  END  LOOP 

2516  ELSE 

2518  Pointer  = First  Jine 

2520  END  IF 

2522  IF  Pointeractive  THEN 

2524  IF  Pointer  = Last  line  THEN 

2526  PRINT  CHR$(1 32); 

2528  ELSE 

2530  PRINT  CHR$(1 28); 

2532  END  IF 

2534  PRINT  TABXYO  fPointer);Marker$;CHR$(1 28); 

2536  END  IF 

2538  RETURN 

2540  SUBEND 
2542  ! 

2544  i*******^******************************************** 

2546  I 

2548  SUB  Errortrap 
2550  Errortrap:  I Original:  13  Nov  1984 
2552  S Revision:  02  Dec  1987 

2554  I Trap  most  errors  here 

2556  OPTION  BASE  1 

2558  COM  /Files/ Diskdrive$[20LFiiename$[1 41fMs_path$(5001 

2560  DIM  File${20LTest$[256],What$(20LAc$[5]  “ 

2562  BEEP  400f.6 

2564  SELECT  ERRN 
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2566 

2568 

2570 

2572 

2574 

2576 

2578 

2580 

2582 

2584 

2586 

2588 

2590 

2592 

2594 

2596 

2598 

2600 

2602 

2604 

2606 

2608 

2610 

2612 

2614 

2616 

2618 

2620 

2622 

2624 

2626 

2628 

2630 

2632 

2634 

2636 

2638 

2640 

2642 

2644 

2646 

2648 

2650 

2652 

2654 

2656 

2658 

2660 

2662 

2664 

2666 

2668 

2670 

2672 

2674 

2676 


CASE  54 

DISP  "DUPLICATE  FILE  NAME:  ";Filename$; 

DISP  "....PURGE  old  one?  (Y/N)’; 

UNPUT  What$ 

What$=TRIM$(What$) 

SELECT  What$(1,1] 

CASE  "Y’,"y" 

PURGE  Ms  path$&Filename$&Diskdrive$ 

CASE  ELSE 
Ac$  = "VALID" 

CALL  Enterfilename(Ac$) 

END  SELECT 
CASE  52,53 

DISP  "Improper  FILE  NAME  — ENTER  NEW  FILE  NAME"; 

OUTPUT  2 USING  "#,K,K";"#";Filename$ 

LINPUT  Filenames 
Filename$  =TRIM$(Filename$) 

CASE  56 

DISP  "FILE:  ";Filename$;"  is  not  on  this  disk,  please  insert"; 

DISP  " correct  disk" 

CALL  Pause_key_on 
CASE  64 

DISP  "This  disk  is  full,  PLEASE  insert  clean  disk" 

CALL  Pause  key_on 
CASE  56 

DISP  "DATA  INPUT  disk  must  be  in  drivel!  "; 

DISP  "...CONTINUE  when  ready." 

CALL  Pause  key  on 
CASE  72,73,76 
DISP  Diskdrive $; 

DISP  " is  not  available,  type  correct"; 

DISP  " unit  specifier  (ie.  ':, 707,0')."; 

OUTPUT  2 USING  "K,#";Diskdrive$ 

LINPUT  Diskdrive$ 

CASE  80 

DISP  "CHECK  DISK  drive  door!" 

CALL  Pause_key  on 
CASE  ELSE 

DISP  ERRM$;"  'CONTINUE'  when  fixed" 

CALL  Pause  keyjjn 
END  SELECT 
DISP  CHR$(1 2) 

SUBEXIT 

SUBEND 

! 

I ***** ***** ***« 

! 

SUB  Data_to_disk_r (INTEGER  Curve, Datacount, REAL  Basket_file(#),Data_id$) 
Data_to_disk_r:  I Original:  1 3 Nov  1 984 
I Revision:  02  Dec  1987 

IThis  routine  will  SAVE  data  files  on  the  disk  in  RAW  data  format. 

OPTION  BASE  1 

COM  /Files/  Diskdrive${20],Filename$l14],Ms_path$[500] 

COM  /Interrupts/  INTEGER  lntr_prty 
INTEGER  Local  prty,Diskspace 
DIM  Ac$[5],Status$l1],Tempfile$[141 
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2678  REAL  Dtime 

2680  OFF  KEY 

2682  Local_prty  = Intrprty 

2684  Dtime  = 0. 

2686  I 

2688  ISelect  the  disk  drive  for  data  storage 

2690  ! 

2692  Selectdrive:  ! 

2694  GRAPHICS  OFF 

2696  OUTPUT  2 USING  °#,K";"K" 

2698  CALL  Select_disk 

2700  IF  Diskdrive$  -"NO  DISK"  THEN  GOTO  Mistakeline 

2702  Choosefilename:  I 
2704  Ac$  = "ABORT" 

2706  Tempfile$  = Filename$ 

2708  CALL  Enterfilename(Ac$) 

2710  IF  LEN(Filename$)  = 0 THEN 

2712  Fi!ename$  ~Tempfile$ 

2714  GOTO  Mistakeline 

2716  END  IF 

2718  Send_t©  jJisk:  I Create  file  and  save  information. 

2720  ON  ERROR  GOTO  Cantmsavedata 

2722  Diskspaee  - SNTMDataeount*  1 6.01/2561  + 2 

2724  CREATE  BOAT  Ms_path$&Filename$&Biskdrive$,Diskspacet256 

2726  Dtime  ^ TIMED  ATE 

2728  DISP  " SAVING  data  for  CURVE  * ".Curve;"  ° 

2730  Status$  -“N" 

2732  ASSIGN  @Datapath  TO  Ms_path$&Filename$&Diskdrive$ 

2734  OUTPUT  @Datapath;Status$ 

2736  OUTPUT  @Datapath;DataJd$  140  chrs  description  if  single  curve 

2738  OUTPUT  @Datapath;Datacount  Inumber  of  xy  points 

2740  OUTPUT  @Oatapath;Dataeount  Isize  of  array  (same  as  above} 

2742  OUTPUT  @Datapath;BasketJileC ) 

2744  ASSIGN  @Datapath  TO  * 

2746  OFF  ERROR 

2748  I 

2750  Mistakeline:OFF  KEY 
2752  LOOP 

2754  EXIT  IF  TIMEDATE-Dtime >1.8 

2756  END  LOOP 

2758  DISP  CHR$(1 2) 

2760  OUTPUT  2 USING  "#,K";"KW 

2762  SUBEXIT 

2764  I 

2766  S //////////////////////////////////////////////////////// 

2768  I 

2770  Cant_savedata:  I 

2772  BEEP  500, .6 

2774  SELECT  ERRN 

2776  CASE  72,73,76 .78,81 ,82.90,93 

2778  DISP  Diskdrive$;"  has  failed  or  is  not  available 

2780  DISP  " ....CONTINUE  to  try  again." 

2782  CALL  Pause  Jceyjan 

2784  Filename$ -Tempfile$ 

2786  CASE  84,85 

2788  DISP  B This  disk  is  not  initialized 
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2790  DISP  " ....CONTINUE  to  try  again." 

2792  CALL  Pause_key_on 

27 94  Filename  $-T  empf  ile  $ 

2796  CASE  55,64 

2798  DISP  " This  disk  is  full,  insert  new  floppy  and/or"; 

2800  DISP  " select  new  drive  ...CONTINUE  " 

2802  CALL  Pause_key_on 

2804  Filename  $ =T  empf  ile  $ 

2806  CASE  ELSE 
2808  CALL  Err ortrap 

2810  GOTO  Send_to  disk 

2812  END  SELECT 

2814  GOTO  Selectdrive 

2816  ! 

2818  SUBEND 
2820  ! 

2822  ! t#**##i#*#f***t*#*t*ft*f****#,****#®**t®***#**ff#tt***®,*# 
2824  ! 

2826  SUB  Load_disk_data(Basket_file(#), INTEGER  Basketsize,Data_id$, INTEGER  Fig) 

2828  Load_disk_data:  I Original:  1 3 Nov  1 984 

2830  ! Revision:  02  Dec  1987 

2832  IThis  routine  will  enter  data  files  from  the  disk 

2834  OPTION  BASE  1 

2836  l 

2838  COM  /Sys / Sys_id$ 

2840  COM  /History/  Status$[1],Time_orgn$[81,Date_orgn$(1 1] 

2842  COM  /History/  Time_chng$(81,Date_chng$[1 1],Description$[1 60] 

2844  I 

2846  COM  /Labels/  Labels$(30)[60], INTEGER  Lbl_count,REAL  Lbljjddr{30,6) 

2848  !Lbl_addr:  x,  y,  pen,  size,  LDIR,  LORG 
2850  ! 

2852  COM  /Data_param/  INTEGER  Datacount,Filesize,Curvecount,Roster(17,4) 

2854  COM  /Data_param/  REAL  Sym_size,Symbol$(17)[2],Curvejd$(17)[40] 

2856  COM  /Data_param/  REAL  Xmin_data,Xmax_data 

2858  COM  /Data_param/  REAL  Ymin_data,Ymax_data 

2860  ! 

2862  IRoster:  Curve#,  Start  Addr  in  File(*),  Datacount,  and  PEN 
2864  !Symbol$(i)  = ""  or  "Y"  = > no  symbol,  connect  pts 
2866  !Symbol$(i)  = "#Y"  = > * symbol,  connect  pts 

2868  !Symbol$(i)  = "#N"  =>  * symbol,  do  not  connect  pts 

2870  ! . 

2872  COM  /Background/  Graphtype$[12],Margins$(2)[10],Papersize$(1] 

2874  COM  /Background/  REAL  Pen_speed, INTEGER  Backgnd_pen,Auto_time 

2876  COM  /Background/  INTEGER  Auto_f ile, REAL  X_cross_y,Y_cross_x 

2878  COM  /Background/  Xgrid_tick$ [4], INTEGER  Xmajor,Xminor 

2880  COM  /Background/  Ygrid_tick$ [4], INTEGER  Ymajor,Yminor 

2882  COM  /Background/  REAL  Xmin_graph,Xmax_graph,Ymin_graph,Ymax_graph 

2884  I 

2886  COM  /Bugs/  INTEGER  Bugl  ,Bug2,Bug3, Printer 

2888  COM  /Interrupts/  INTEGER  lntr_prty 

2890  COM  /Enlarge_file/  INTEGER  Overflow 

2892  COM  /Files/  Diskdrive$[20],Filename$[14],Ms„path$[500] 

2894  COM  /Datajstuff/  INTEGER  Number, REAL  Delta_x,REAL  Strt_time 

2896  ! 

2898  INTEGER  R,Hold_size,Local_prtylAllocatedfFls_cnt 

2900  DIM  Ac$[5],Tempfile$(10],Mask$l10],Ftype$T5],Fls$(1)[14] 
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2902  REAL  Dtime 

2904  OFF  KEY 

2906  Local_prty  - lntr_prty 

2908  ! 

2910  (Select  the  disk  drive  where  the  data  exists 
2912  I 

2914  IF  Overflow  < >0  THEN  Overflow  = 0 
2916  Ho!d_size  = 0 

2918  Dtime -0. 

2920  Allocated  =0 

2922  Selectdrive:  I 

2924  IF  Diskdrive  $ = "NO  DISK"  THEN  Diskdrive$  = "" 

2926  IF  LEN(Diskdrive$)>0  THEN  GOTO  Choosefilename 

2928  GRAPHICS  OFF 

2930  OUTPUT  2 USING  "#,K";"K" 

2932  CALL  Selectjlisk 

2934  IF  Diskdrive$  =*N0  DISK"  THEN  GOTO  Mistakelineset 

2936  Choosefilename:  I 

2938  Tempfile$  = Filenames 

2940  IF  LEN (Filename $)>0  THEN  GOTO  Bringjnjiata 
2942  Ac$  - "CAT" 

2944  CALL  Enterfilename(Ae$| 

2946  IF  LEN  (Filename  $ I •-  0 OR  POS(Filename$fB*  1 THEN 
2948  IF  P0S(F»lename$l**"5>  1 THEN  ! set  mask$ 

2950  Mask$  = Filename$[1  ,POS(Filename$,"*"H  J 

2952  Filename$  -s" 

2954  ELSE 

2956  Mask$  ~""l  no  preselection 

2958  END  IF 

2960  Ftype$  = "BDAT  " I examine  BOAT  files  only 

2962  Fls_cnt=1  I select  one  file 

2964  Intrprty  = Local  _prty  + 1 

2966  CALL  File_menu(Mask$,Ftype$„Fls$(*KFIs_cnt,0,0) 

2968  lntr_prty  = Local_prty 

2970  Filenames  =Fls$(1 ) 

2972  IF  LEN(FilenameS)  =0  THEN  I aborted 

2974  Filenames  =Tempfile$ 

2976  GOTO  Mistakelineset 

2978  END  IF 

2980  END  IF 

2982  Bringjn_data:  I 
2984  I 

2986  IFind  this  file  on  the  disk. 

2988  ! 

2990  ON  ERROR  GOTO  Cantjindfile 

2992  ASSIGN  @Datapath  TO  Fiiename$&Diskdrive$ 

2994  OFF  ERROR 

2996  Dtime  = TIMEDATE 

2998  DISP  " LOADING  disk  file:  ";Filename$;"  ...  "; 

3000  ON  ERROR  GOTO  Badjile 

3002  ENTER  @Datapath;Status$ 

3004  OFF  ERROR 

3006  ON  ERROR  GOTO  Cantjindfile 

3008  SELECT  Status$ 

3010  CASE  "Y"  I All  graphics/data  parameters  exist.REN  100,2 
3012  DISP  B Complete  graph.  " 
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3014 

3016 

3018 

3020 

3022 

3024 

3026 

3028 

3030 

3032 

3034 

3036 

3038 

3040 

3042 

3044 

3046 

3048 

3050 

3052 

3054 

3056 

3058 

3060 

3062 

3064 

3066 

3068 

3070 

3072 

3074 

3076 

3078 

3080 

3082 

3084 

3086 

3088 

3090 

3092 

3094 

3096 

3098 

3100 

3102 

3104 

3106 

3108 

3110 

3112 

3114 

3116 

3118 

3120 

3122 

3124 


ENTER  @Datapath;Time_orgn$,Date_orgn$ 

ENTER  @Datapath;Time _chng  $ f Date_chng  $ 

ENTER  @Datapath;Description$ 

ENTER  @Datapath;Labels$d),Lbl_count,Lbl_addrd) 
ENTER  @Datapath;Curve  Jd  $ ( * },  Symbol  $ ( # ) 

ENTER  @Datapath;Roster(  * ),Curvecount 
ENTER  @Datapath;Graphtype$,Margins$d) 

ENTER  @Datapath;X_cross_y,Y_cross_x 
ENTER  ©Datapath, •Xgrid_tick$,Xmajor,Xminor 
ENTER  @Datapath;Ygrid_tick$,Ymajor,Yminor 
ENTER  @Datapath;Xmin_graph,Xmax_graph 
ENTER  @Datapath;Ymin_graph,Ymax_graph 
CASE  "N"  ! Only  data  parameters  exist. 

DISP  " RAW  data.  " 

CASE  ELSE 

Badjile:  DISP  CHR$(12» 

DISP  "Data  file  is  not  recognized,  entry  aborted."; 

DISP  " ...continue." 

BEEP 
PAUSE 
OFF  ERROR 
GOTO  Mistakelineset 
END  SELECT 
! 

ENTER  @Datapath;DataJd$ 

IF  Fig  THEN 

ENTER  @Datapath;Delta_x 
ENTER  @Datapath;Datacount 
Hold  size  = Datacount 
ELSE 

ENTER  @Datapath;Datacount 
ENTER  @Datapath;Hold  size 
END  IF 

IF  NOT  Allocated  THEN 

IF  Datacount  > =1  AND  Hold_size>  =1  THEN 
ALLOCATE  Holding  file(Hold  size,2) 

ELSE 

ALLOCATE  Holdingjiled  ,2) 

END  IF 
Allocated  = 1 
END  IF 

ENTER  @Datapath;Holding_filed) 

ASSIGN  ©Datapath  TO  # 

OFF  ERROR 
IF  NOT  Fig  THEN 

Delta_x  = Holding_f  ile(2, 1 )-Holding_f  ile(  1,1) 

Strt_time  = Holding  filed  ,1) 

Fig  = 1 
END  IF 

IF  Datacount  = 0 THEN  Mistakeline 
! 

ICopy  data  from  Holding  filed)  to  Basket_filed) 

! 

MAT  Basket_file  = (0.) 

IF  Datacount >Basketsize  THEN  (Receiving  file  too  small. 
Allocated  = 0 
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3126  DEALLOCATE  Holding Jile(*) 

3128  DISP  " DATA  FILE  overflow,  new  data  discarded. 

3130  DISP  " (continue)  " 

3132  BEEP 

3134  PAUSE 

3136  IF  Status$-"Y"  THEN 

3138  Curvecount  = 0 

3140  MAT  Roster  = <0* 

3142  END  IF 

3144  Overflow  - Hold_size 

3146  GOTO  Mistakelineset 

3148  END  IF 

3150  Copydatafile:  I 

3152  FOR  R - 1 TO  Datacount 

3154  Basket_f  ile(R,  1 ) = Holding_f  ile(R,  1 ) 

3156  Basket  file(R,2)  = Holding_file(R,2) 

3158  NEXT  R 

3 1 60  Basketsize  = Datacount 

3162  GOTO  Mistakeline 

3164  l 

3166  Mistakelineset:Datacount  - 0 
3168  Mistakeline:OFF  KEY 

3170  IF  Allocated  THEN  DEALLOCATE  Holding  JileP) 

3172  LOOP 

3 1 74  EXIT  IF  TIMEDATE-Dtime  > 1 .8 

3176  END  LOOP 

3178  DISP  CHR$(1 2) 

3180  OUTPUT  2 USING 

3182  SUBEXIT 

3184  I 

3186  ! //////////////////////////////////////////////////////// 

3188  I 

3190  Cant  findfile:  lError  in  searching  for  the  file. 

3192  BEEP  500, .6 

3194  SELECT  ERRN 

3196  CASE  56 

3198  DISP  "That  file  does  not  exist  on  this  disk 

3200  CASE  72,73,76,82 

3202  DISP  Diskdrive$;B  has  failed  or  is  not  available 

3204  CASE  ELSE 

3206  DISP  ERRM$; 

3208  END  SELECT 

3210  DISP  " ....CONTINUE  to  try  again." 

3212  PAUSE 

3214  Filename  $ = "" 

3216  Diskdrive  $ = "" 

3218  GOTO  Selectdrive 

3220  I 

3222  SUBEND 
3224  \ 

3228  I 
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B.4  PULS  PARAMS 


100!  RE-STORE  "PULS_PARAMS:,1400" 

102  I 

104  COM /Sys/ Sys  id$(10] 

1 06  COM  /Sysjnsi/  Msi Jd  $ [20] 

108  COM  /Interrupts/  INTEGER  Intr  prty 
110  ! 

112  OUTPUT  KBD  USING  "K,#";" SCRATCH  KEYE"  [ERASE  SOFT  KEYS 
1 14  CONTROL  KBD,15;0!  sets  the  color  of  the  soft  keys 
116  CONTROL  KBD, 2;  1 
118  ! 

1 20  Intrprty  = 1 
1 22  CALL  Pulseparams 
124  ! 

1 26  CLEAR  SCREEN 

128  OUTPUT  KBD  USING  "K,#";"LOAD  KEYE"!  restore  the  typing  aid  keys 
1 30  PRINT  TABXYil  ,5);*END  of  program.  So  long." 

132  MASS  STORAGE  IS  1400" 

134  ! 

136  END 
138  I 

140  I 

142  ! 

144  SUB  Pulse_params 
1 46  ! 

148  Pulse_params:  ! 

1 50  OPTION  BASE  1 

152  RAD 

154  COM /Volt_vals/ Vmin,Vmax,VJast, Volt  z,Volt_100,V_first,Vptp 

156  COM  /Time_vals/  Tm  10,Tm_20,Tm_507Tm_80,Tm_90,Tr1  J0,Tr1_20 

1 58  COM  /Time_vals/  Tr2J  0,Tr2„20,Pls_dur,Tm2  J 0,Tm2_20,Tm2_50,Tm2_80 

160  COM  /Time_vals./  Tm2_90 

162  COM  /Miscjnt/  INTEGER  No_o_bins,His_zero_lev 

164  COM  /Miscjnt/  INTEGER  His_JOOJev,Maxpoint 

1 66  COM  /Misc  real/  Delta_v,Delta  v_prc,Ov,Undr 

168  COM  /Units/  X_units$[20],Y_units$[20] 

170  COM  /Files/  Diskdrive$[20]fFilename$[14],Ms_path$[500] 

172  ! 

174  Dateline:  ! 

176  i- —————— 

178  ! This  program  written  by  S.M.  Chesnut 

180  I October  12,  1990 

182  ! Last  revision:  May  21,1991 

184 

1 86  INTEGER  Hist_ary(32767),Pnts,Typ 

188  REAL  Wave(32767,2) 

190  DIM  DataJd$[40],Dataname$[10],Ch$[1] 

192  Ch$  = "y" 

194  I 

1 96  WHILE  (Ch$  = "Y")  OR  (Ch$  = "y") 

198  DISP  "Enter  the  name  of  the  file  when  prompted." 

200  WAIT  1 .0 

202  Diskdrive$  = "" 

204  Filename$  = "" 

206  Pnts  = 32767 

208  REDIM  Wave(Pnts,2) 
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210 
212 
214 
216 
218 
220 
222 
224 
226 
228 
230 
232 
234 
236 
238 
240 
242 
244 
246 
248  ! 
250  ! 
252  I 
254 
256 


CALL  Load_disk_data(Wave( # ),Pnts, Data jd $ ) 

IF  Pnts  = 0 THEN 
BEEP 

DISP  "NO  FILE  WAS  READ,  type  continue  to  try  again." 
PAUSE 
Pnts  = 32767 
ELSE 

Dataname$  = Filename  $ 

INPUT  "What  are  the  units  of  the  x axis?",Xjjnits$ 
INPUT  "What  are  the  units  of  the  y axis?",Yjjnits$ 
REDIM  Wave(Pnts,2) 

CALL  Mak_histogram(Wave(#),Pnts,Hist_ary(*)| 

CALL  Parameters(Pnts,Wave(*),Typ) 

CALL  Write_data(Typ,Dataname$) 

END  IF 

INPUT  "Another  file?  y/n  (default  is  yes)",Ch$ 

END  WHILE 
SUBEXIT 
SUBEND 


*#***»«**••««€>**«**«>#*£#'«««>««»«*«*'&*«*««#««*#*«##*#*#*«»«*«*«*****«« 


SUB  Mak_histogram(REAL  Wave(#), INTEGER  Pnts, INTEGER  Hist_ary(#)) 


258  Mak_histogram:  I 

260  ~ I 

262  OPTION  BASE  1 

264  RAD 

266  COM  /Volt_vals/  Vmin,Vmax,VJast,Volt_z,VoltJOO,V_first,Vptp 

268  COM  /Timej/als/  Tm  10,Tm_20,Tm_50,Tm_80,Tm_90,Tr1_10fTr1_20 

270  COM  /Time_vals/  Tr2_1 0,Tr2_20,Pls_dur,Tm2  J 0,Tm2_20,Tm2_50,Tm2_80 

272  COM  /Tlme_vals/  Tm2_90 

274  COM  /Misejnt/  INTEGER  No_o_bins,His_zero_lev 

276  COM  /Misejnt/  INTEGER  His  J OOJev.Maxpoint 

278  COM  /Mise_real/  Delta_v,Delta_v_prc,Ov,Undr 

280  COM  /Files/  Diskdrive$[20],Filename$(14],Ms_path$[500] 

282  COM  /Units/  X_units$(20],Y_units$[20] 

284  ! 

286  INTEGER  lndx,Min_bin,Half_bin,l,LeveI,Zipo, Hundred, Done, Auto 

288  DIM  Ch$[1] 

290  DISP  "Calculating  the  histogram,  please  wait." 

292  Auto  = 1 

294  Done-0 

296  Level  “0 

298  Ch$  =s"n" 

300  CALL  Vmax_min_ptp(Wave(*),Pnts,Vmax,Vmin,Vptp,Maxpoint) 

302  No_o_bins  = 1 6384 

304  Min_bin  = Pnts  DIV  100 

306  WHILE  (Ch$  = "n")  OR  (Ch$  = T) 

308  WHILE  NOT  Done 

3 1 0 Delta_v  = Vptp/Noo  J)ins 

312  Half  bin  = No_o_bins  DIV  2 

314  MAT  Histary  = (0) 

316  FOR  I ~ 1 TO  Pnts 

318  IF  1 < =(32767-{INT((Wave(l,2)*Vmin)/Delta_v)))  THEN 

320  Level  = 1 +INT((Wave(!,2)-Vmin)/Delta_v) 

322  ELSE 

324  Levels  No  o bins 
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326 

END  IF 

328 

Hist  ary(Level)  = Hist  ary(Level)  + 1 

330 

NEXT  f 

332 

Bugl  =0 

334 

IF  Bugl  THEN 

336 

PRINTER  IS  PRT 

338 

FOR  1 = 1 TO  No  o bins 

340 

PRINT  Hist  ary(U 

342 

NEXT  1 

344 

PRINTER  IS  CRT 

346 

END  IF 

348 

Bugl  =0 

350 

His_zero  Jev  = 0 

352 

His_100_lev  = 0 

354 

Zipo=0 

356 

Hundred =0 

358 

FOR  1 = 1 TO  HalfjDin 

360 

IF  Hist  aryd)  > His_zeroJev  THEN 

362 

His_zero_lev  = Hist_ary(l) 

364 

Zipo  = l 

366 

END  IF 

368 

NEXT  1 

370 

1 = Half  bin 

372 

WHILE~KNo  o bins 

374 

IF  Hist_ary(l  + 1 ) > His  J 00 Jev  THEN 

376 

His_1  OOJev  = Hist_ary  (1  + 1 ) 

378 

Hundred  = 1 + 1 

380 

END  IF 

382 

1 = 1 + 1 

384 

END  WHILE 

386 

IF  Auto  THEN 

388 

IF  (His_zero Jev  < Min_bin)  THEN 

390 

No  o bins  = No  o bins  DIV  2 

392 

IF  No_o_bins<  128  THEN 

394 

GOSUB  Histjnessage 

396 

Done  = 1 

398 

END  IF 

400 

ELSE 

402 

Done  = 1 

404 

END  IF 

406 

ELSE 

408 

Done  = 1 

410 

END  IF 

412 

END  WHILE 

414 

GOSUB  Calc_v_prms 

416 

GOSUB  Hist  query 

418 

END  WHILE 

420 

SUBEXIT 

422  Hist 

.message:  I 

424 

PRINT  "The  number  of  bins  in  the  histogram  is  less  than  128." 

426 

PRINT  "Therefore,  the  voltage  resolution  is  quite  bad  and  you" 

428 

PRINT  "may  find  it  is  unacceptable.  Keep  this  in  mind  when  you 

430 

PRINT  "are  asked  if  the  histogram  is  an  acceptable  one." 

432 

WAIT  2.0 

434 

RETURN 

436  ! 
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438  Calc_v_prms:  l 

440  Volt_z  = Vmin  + Zipo  * Delta_v-Delta_v/2. 

442  Voltl  00  = Vmin  + Hundred  * Delta  v-Delta_v/2. 

444  V_first  = Wave(1 ,2) 

446  Vlast  ~ Wave(Pnts,2) 

448  Delta_v_prc  = Delta_v  # 1 00  A/ptp 

450  RETURN 

452  ! 

454  Hist_query:  I 
456  ! 

458  CLEAR  SCREEN 

460  PRINT  "The  first  waveform  point  = ";PR0UND(V_first,-4);"  ";Y_units$;\" 

462  PRINT 

464  PRINT  " The  last  waveform  point  = ";PR0UND(VJast,-4);"  ";Y_units$;"." 

466  PRINT 

468  PRINT  "The  minimum  = ";PR0UND(Vmin,-4);"  ";Y_units$;V 
470  PRINT 

472  PRINT  "The  maximum  * ";PR0UND(Vmaxs-4);"  ";Y_units$;"." 

474  PRINT 

476  PRINT  "There  were  ";No_o_bins;"bins  used  in  the  histogram." 

478  PRINT 

480  PRINT  "Each  histogram  bin  is  equivalent  to";PROUND(Delta  v,~5);"  ";Y_units$;"," 

482  PRINT 

484  PRINT  "or";PROUND(Delta  v_prc,-5);"%  of  the  waveform  peak-to-peak." 

486  PRINT 

488  PRINT  "The  0%  level  occurs  at";PROUND(Volt_z,-4);B  ”;Y_units$;K  with";His_zeroJev;"occurences." 

490  PRINT 

492  PRINT  "The  100%  level  occurs  at" ;PROUND(VoltJ  00,-4);"  ";Y_units$;" 
with";His_100Jev;"occurrenceSo" 

494  INPUT  "Is  this  an  acceptable  histogram?", Ch$ 

496  IF  {Ch$  -"n")  OR  (Ch$  = "N"|  THEN 

498  INPUT  "How  many  histogram  bins  would  you  like  to  use?B„No=o_bins 

500  Done  = 0 

502  Auto^O 

504  END  IF 

506  CLEAR  SCREEN 

508  RETURN 

510  SUBEND 

512  ! 

514  !*•**«*** * * **.****««********* 

516  I 

518  SUB  Vmax_min_ptp(REAL  Wave!*), INTEGER  Pnts,REAL  Vmax, Vmin, Vptp, INTEGER  Maxpoint) 

520  ! 

522  Vmax_min_ptp:  ! 

524  INTEGER  I 

526  Vmax  = Waved ,2) 

528  Vmin  = Wave(1 ,2) 

530  FOR  I = 1 TO  Pnts 

532  IF  Waved, 2)  < Vmin  THEN  Vmin  = Waved, 2) 

534  IF  Waved, 2)  > Vmax  THEN 

536  Vmax -Waved, 2) 

538  Maxpoint -I 

540  END  IF 

542  NEXT  I 

544  Vptp  = Vmax~Vmin 

546  SUBEXIT 
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548 

550 

552 

554 

556 

558 

560 

562 

564 

566 

568 

570 

572 

574 

576 

578 

580 

582 

584 

586 

588 

590 

592 

594 

596 

598 

600 

602 

604 

606 

608 

610 

612 

614 

616 

618 

620 

622 

624 

626 

628 

630 

632 

634 

636 

638 

640 

642 

644 

646 

648 

650 

652 

654 

656 

658 


SUBEND 

! 

! 

! 

SUB  File_menu(Mask$,Ftype$,Fls$(*), INTEGER  Fls_cnt,Dir_on,Prt_on) 
Fiie_menu:  ! 

! Original:  29  Jun  1987,  G.  Koepke 
! Revision:  06  Aug  1987,  10:00 
OPTION  BASE  1 
DEG 

COM  /Sys/  Sys_id$[10] 

COM  /Files/  Diskdrive$(20],Filename$l14],Ms_path$[500] 

COM  /Interrupts/  INTEGER  lntr_prty 
DIM  Directory$(1 50)(80], Bd${1 50)171  ] 

DIM  D$(80],T$(52],lds$[40],Stat$[1] 

INTEGER  Bd_cnt,File_cnt,l,C  cnt,C0(1  ),Format_error 
IF  FIs  cnt>0  THEN  ALLOCATE  INTEGER  Choose(Fls_cnt) 

I 

I Catalog  the  disk  specified 
! 

ON  ERROR  GOTO  Cat_errors 
DISP  " Reading  the  Directory  ...  " 

MASS  STORAGE  IS  Diskdrive  $ 

CAT  TO  Directory $(*);NO  HEADER, COUNT  File^cnt 
OFF  ERROR 
! 

I set  up  array  of  legal  file  names. 

! 

Bd_cnt  = 0 

FOR  I = 1 TO  File_cnt 

IF  Directory $(l)[32, 36]  = Ftype$  THEN  ! Ftype$  = "BDAT  B 

! Ftype$  = "PROG  " 

IF  LEN(Mask$)>0  THEN  ! Test  for  mask$ 

IF  Directory $(l)[1,LEN(Mask$)]=Mask$  THEN 
Bd_cnt  = Bd_cnt  + 1 
Bd$(Bd  cnt)  = Directory $(l)[1;  10] 

END  IF 
ELSE 

Bd_cnt  = Bd_cnt  + 1 

Bd  $ (Bd_cnt)  = Directory  $ (I)  [1 ; 1 0] 

END  IF 
END  IF 
NEXT  I 
! 

I set  up  file  menu 
! 

D$  = "Select  "&VAL$(Fls_cnt)&"  file  names  for  data  entry." 

T$  = "List  of  "&Ftype$&"files  on  "&Diskdrive$ 

IF  LEN(Mask$)>0  THEN 
T$=T$&"  mask  = "&Mask$ 

END  IF 

IF  Bd_cnt  > 0 THEN 

IF  Dir_on>0  THEN  GOSUB  Read_data_id 
IF  Prt_on  THEN 

GOSUB  List_directory 
ELSE 


B141 


660 

662 

664 

666 

668 

670 

672 

674 

676 

678 

680 

682 

684 

686 

688 

690 

692 

694 


698 


C_cnt  = Fls_cnt 
DISP  CHR$(1 2) 

IF  Fls_cnt>0  THEN 

CALL  Menu_scroll (D  $ ,T $ , Bd  $ ( # ) , Bd_cnt, C_cnt,Choose(  * ) ) 
ELSE 

CALL  Menu_scroll (D $ ,T$  ,Bd  $ ( # ),  Bd  _cnt,C_entcC0( e )) 

END  IF 
I 

! transfer  file  names  to  Fls$(#). 

! 

IF  C ent  ”0  THEN  ! selection  process  aborted 
MAT  Fls$  - ("") 

ELSE 

MAT  SORT  Chooser) 

FOR  1-1  TO  C_cnt 

Fls$(l)  * Bd$(Choose(l))[1 ; 1 01 
NEXT  I 
END  IF 
END  IF 
ELSE 

DISP  B This  directory  contains  no  BOAT  files  ...  B 


710  Cat 

712 

714 

716 

718 

720 


:ERRM$ 


724 

726 


END  IF 

DISP  CHR$(1 2) 
SUBEXIT 
errors:! 

* DISP  "ERROR  ... 
BEEP 
PAUSE 
G_ent  = 0 
MAT  Fls$  - (”) 
SUBEXIT 


I //////////////////////////////////////////////////// 


730  Readjlatajd:  ! This  routine  expects  to  see  lds$  from 
732  ! GRAPHJDATA  raw  data  files. 

734  DISP  " Reading  file  contents  ...  " 

736  FOR  1-1  TO  Bd_cnt  S each  BDAT  file 
738  lds$  = ”Data  not  recognized." 

740  ON  ERROR  GOTO  Not_recognized 

742  ASSIGN  @lo_path  TO  Bd$(l)[1;10] 

744  ENTER  @loj3ath;Stat$ 

746  SELECT  Stat$ 

748  CASE  "N" 

750  ENTER  @loj)ath;lds$ 

752  CASE  "Y" 

754  lds$  = "Complete  graph  ...  use  GRAPH  DATA." 

756  END  SELECT 

758  Notj’ecognized:  ASSIGN  @lo_path  TO  * 

760  OFF  ERROR 

762  IF  Dir  on-2  THEN 

764  GOSUB  Interpret^ 

766  IF  Format^error  THEN  GOTO  Other  format 

768  GOTO  Go  on 

770  END  IF 


B142 


772  Other  format:! 

774  ~ Bd$(l)[1 1 ,71]  = " ...  "&lds$ 

776  Go_on:  NEXT  I 
778  RETURN 

780  ! 

782  ! /////////////////////////////////////////////////// 

784  ! 

786  Interpret^:  ! This  is  used  to  interpret  TEM  program  ID  strings. 

788  Format_error  = 0 

790  ! identify  this  particular  format 

792  IF  LEN(lds$)<40  THEN 

794  Format  error  = 1 

796  RETURN 

798  END  IF 

800  IF  lds$[40]  < > " * " THEN 

802  Format  error  = 1 

804  RETURN 

806  END  IF 

808  ! make  the  information  readable 

810  Bd$(l)[1 1,15]  = " ...  " 

812  Bd$(l)[1 6,25]  = lds$(1  f 1 0] 

814  Bd$(l)[26,32]  = ",  "&lds$[1 1,12]&":"&lds$[13,14] 

816  Bd$(l)[33,42]  "&lds$[1 5,1 6]&"  "&lds$[1 7,1 8]&"  "&lds$[1 9,20] 

818  Bd$(l)[43,55]  = ",  "&lds$[21 ,27]&"  MHz" 

820  Bd$(l)I56,65]  = ",  "&Ids$[28,33]&"vm" 

822  Bd$(l)[66,71]  = V&lds$t38,39] 

824  RETURN 

826  I 

828  ! /////////////////////////////////////////////////// 

830  ! 

832  List_directory:  ! This  routine  will  provide  a tabular  listing  of 
834  ! the  directory  along  with  lds$  if  provided 

836  ! 

838  DISP  " Listing  directory  ...  " 

840  PRINTER  IS  PRT 

842  PRINT  USING  "//" 

844  PRINT  T$ 

846  PRINT  RPT$("-",80) 

848  PRINT  "File  name"; 

850  IF  Dir_on  THEN 

852  PRINT  " ...  contents" 

854  ELSE 

856  PRINT 

858  END  IF 

860  PRINT  RPT$("-",80) 

862  FOR  I = 1 TO  Bd_cnt 

864  PRINT  Bd$(l)~ 

866  NEXT  I 

868  PRINT  RPT$(V,80) 

870  PRINT 

872  PRINTER  IS  CRT 

874  RETURN 

876  SUBEND 
878  ! 

880  ! 

882  ! 
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884  SUB  Fifty_percent(REAL  Waved, Wv_50, INTEGER  Pnts,Start_pos,Typ) 

886  I 

888  Fifty_percent:  I 

890  ! 

892  OPTION  BASE  1 

894  RAD 

896  1 

898  INTEGER  1, Found 

900  I = Startjjcs 

902  Found  = 0 

904  WHILE  (NOT  Found)  AND  (l<  =Pnts)  AND  (l>0) 

906  IF  Waved, 2)  < Wv=50  THEN  Found  = 1 

908  1 = 1-1  *Typ 

910  END  WHILE 

912  Start_pos  = l + 1 *Typ 

914  SUBEXIT 

916  SUBEND 

918  ! 

922  ! 

924  DEF  FNPuisjyp(REAL  Last,Wv=90) 

926  Puls^typ:  S 

928  IF  (Last>Wv  90)  THEN 

930  RETURN  1 i step  like  waveform 

932  ELSE 

934  RETURN  -1!  impulse  like 

936  END  IF 

938  FNEND 
940  ! 

944  l 

946  SUB  Rev_pol (INTEGER  Pnts,REAL  Wave(*),Wv_10,Wv_90,Wv_amp,Wv_base) 

948  ! 

960  Revjaol:  I 
952  ! 

954  INTEGER  1 

956  FOR  I = 1 TO  Pnts 

958  Waved, 2)  = Wvjmp  + Wvbase-Waved,2) 

960  NEXT  I 

962  SUBEXIT 

964  SUBEND 
966  I 

968  I* **************************************************************** 
970  I 

972  SUB  Time  o prcnt(REAL  Wave(*),Wv_pct,Pct_t,lNTEGER  Pnts,Drectn,Strt,Typ) 

974  ! 

976  I This  subroutine  assumes  all  waveforms  are  positive  going,  i.e.  they 
978  ! start  at  on  level  and  increase  to  another  level.  If  the  original 

980  ! waveform  had  a negative  polarity,  this  was  remedied  earlier  in 

982  ! the  program. 

984  ! 

986  Time  o prcnt:  S 

988  I Imports:  wave,  an  array  of  data 

990  ! wv  pct,  any  desired  percentage  level 

992  I pnts,  the  number  of  data  points 

994  I drectn  = 1 if  wvjDCt  > = 50% 
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996  l drectn  = -1  if  wv_pct  < 50% 

998  ! typ  = 1 for  a step  or  the  positive  slope  of  an  impulse 

1000  ! typ  = -1  for  the  negative  slope  of  an  impulse 

1002  ! Modifies:  strt,  the  time  "position"  of  the  percent  level  of  interest. 
1004  ! 

1006  INTEGER  I, Found 

1008  REAL  Dx 

1010  I = Strt 

1012  Found  = 0 

1014  Dx  = Wave(2, 1 )-Wave(  1,1) 

1016  WHILE  ((NOT  Found)  AND  (l<  =Pnts)  AND  (l>0)) 

1018  IF  Drectn  = Typ  THEN 

1020  IF  Wave(l,2)>Wv_pct  THEN 

1 022  Found  = 1 

1024  IF  (Typ  = 1)  THEN  1 = 1-1 

1026  ELSE 

1028  1 = 1 + Drectn 

1030  END  IF 

1032  ELSE 

1034  IF  Wave(l,2)<Wv_pct  THEN 

1036  Found  = 1 

1038  IF  (Typ  = -1)  THEN  1 = 1-1 

1040  ELSE 

1 042  1 = 1 + Drectn 

1 044  END  IF 

1 046  END  IF 

1048  END  WHILE 

1 050  Pet  t = 1*  1 .0*Dx  + Dx* (Wv_pct-Wave(l,2))/(Wave(l  + 1 ,2)-Wave(l,2)) 
1052  SUBEXIT 

1054  SUBEND 
1056  ! 

1058  ! *********** 

1060  ! 

1062  SUB  Polarity  (INTEGER  Pnts, Polar, REAL  Wave(*),WvJ0,Wv_90) 

1064  ! 

1066  Polarity:  I 

1068  OPTION  BASE  1 

1070  RAD 

1072  ! This  subroutine  determines  the  polarity  of  the  waveform. 

1074  ! 

1076  ! Imports:  pnts,  wave,  wv_10,  & wv_90 
1078  ! Exports:  polar  = 1 if  positive,  =1  if  negative. 

1080  ! 

1082  INTEGER  I, Found 

1084  I 

1086  Found  = 0 

1088  1=1 

1090  WHILE  (NOT  Found)  AND  (l<  =Pnts) 

1092  IF  (Wave(l,2)<WvJ0)  THEN 

1094  Polar  =1 

1096  Found  = 1 

1098  END  IF 

1100  IF  (Waved, 2)  > Wv_90)  THEN 

1102  Polar  = -1 

1104  Found  = 1 

1106  END  IF 
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1108 

1110 

1112 

1114 

1116 

1118 

1120 

1122 

1124 

1126 

1128 

1130 

1132 

1134 

1136 

1138 

1140 

1142 

1144 

1146 

1148 

1150 

1152 

1154 

1156 

1158 

1160 

1162 

1164 

1166 

1168 

1170 

1172 

1174 

1176 

1178 

1180 

1182 

1184 

1186 

1188 

1190 

1192 

1194 

1196 

1198 

1200 

1202 

1204 

1206 

1208 

1210 

1212 

1214 

1216 


1 = 1 + 1 
END  WHILE 
SUBEXIT 
SUBEND 
! 


SUB  Prcnt(REAL  Amp, Top, Baseln,  Wv  10,Wv_20,Wv_50,Wv_80,Wv  90,Ov,Und,Vmin,Vmax) 

! 

Prcnt:  ! 

I 

Wv_1 0 = Amp  * . 1 + Baseln 
Wv_20  = Amp  * .2  + Baseln 
Wv_50  = Amp  * „5  + Baseln 
Wv_80  = Amp  # .8  + Baseln 
Wv_90  = Amp*. 9 + Baseln 
Und  = (Basein-Vmin)/Amp*  1 00 
Ov  = (Vmax-Top)/Amp*  1 00 
SUBEXIT 
SUBEND 
! 

SUB  Select_value(REAL  Wave_topffWave_base| 

I 

Select_value:  ! 

! 

I This  program  returns  the  values  for  the  waveform  topline  and 
! waveform  baseline. 

! 

OPTION  BASE  1 
RAD 

! 

COM  /Volt  vals/  Vmin,Vmax(VJast,Volt_z„Volt_1 00,V_first,Vptp 
COM  /Timej/als/  TmJ0,Tm_20,Tm_50,TmM80,Tm_90,Tr1  J0JY1^20 
COM  /Time_vals/  Tr2_1 0,Tr2„20,P!sjiur,Tm2  _1  0,Tm2m20,Trn2_50,Trn2_80 
COM  /Time_vals/  Tm2_90 

COM  /Miscjnt/  INTEGER  No  jD_bins,  INTEGER  His^zerojev 
COM  /Miscjnt/  INTEGER  His  _1 00Jev,Maxpoint 
COM  /Misc_real/  Delta_v,Delta_v_prc,Ov,Undr 

! 

INTEGER  Defn,Defnz 

! 

PRINT  "The  0%  level  occurs  at";PROUND(Volt_z,-4);"  ";Y_units$,°"  with";His_zero_lev;"occurences. 
PRINT  "The  100%  level  occurs  at";PROUND(Volt_1 00,-4);"  ";Yjjnits$;" 
with”;His_100  !ev;"occurences.” 

PRINT  " B 

PRINT  "0%  definition  ? 1 = voltage  of  first  point” 


PRINT  " 

PRINT  " 

PRINT  B 
PRINT  • 

PRINT  " ” 
INPUT  Defnje 
SELECT  Def n_z 
CASE  1 


2=  voltage  of  last  point” 

3 = minimum  voltage" 

4 = histogram  0%  voltage* 
ELSE  =user  defined  voltage" 
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1218 

1220 

1222 

1224 

1226 

1228 

1230 

1232 

1234 

1236 

1238 

1240 

1242 

1244 

1246 

1248 

1250 

1252 

1254 

1256 

1258 

1260 

1262 

1264 

1266 

1268 

1270 

1272 

1274 

1276 

1278 

1280 

1282 

1284 

1286 

1288 

1290 

1292 

1294 

1296 

1298 

1300 

1302 

1304 

1306 

1308 

1310 

1312 

1314 

1316 


Wave  base  = V first 
CASE  2 

Wave_base = VJast 
CASE  3 

Wave  base  = Vmin 
CASE  4 ” 

Wave_base  = Volt  z 
CASE  ELSE 

INPUT  "Input  0%  level", Wave  base 
END  SELECT 

IF  Wave_base  < Vmin  THEN 
BEEP 

PRINT  "WARNING:  the  0%  level  is  less  than  the  minimum  voltage" 
PRINT  "of  the  waveform." 

END  IF 

! 

PRINT  "100%  definition  ? 1 = voltage  of  first  point" 

PRINT  " 2=  voltage  of  last  point" 

PRINT"  3 = maximum  voltage" 

PRINT  " 4 = histogram  0%  voltage" 

PRINT  " ELSE  =user  defined  voltage" 

PRINT  " " 

INPUT  Defn 
SELECT  Defn 
CASE  1 

Wave_top  = V first 
CASE  2 

Wave  top  = V last 
CASE  3 ” 

Wave  top  = Vmax 
CASE  4 ~ 

Wave_top  = Volt  100 
CASE  ELSE 

INPUT  "Input  100%  level", Wave  top 
END  SELECT 

IF  Wave  top  > Vmax  THEN 

beep" 

PRINT  "WARNING:  the  100%  level  is  greater  than  the  maximum" 
PRINT  "voltage  of  the  waveform." 

END  IF 

Volt_z = Wave=base 
Volt  100=Wave_top 
CLEAR  SCREEN 
SUBEXIT 
SUBEND 
! 



! 

SUB  Parameters  (INTEGER  Pnts.REAL  Wave(#), INTEGER  Typ) 

I 


1 31 8 Parameters:  I 
1320  ! 

1322  OPTION  BASE  1 

1 324  RAD 

1326  COM  A/olt_vals/  Vmin, Vmax, V_last,Volt_z,Volt_1 00, V_first,Vptp 

1 328  COM  /Time_vals/  TmJ  0,Tm_20,Tm_50,Tm_80,Tm_90,Tr  1 _1 0,Tr  1 _20 
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1 330  COM  /Time_vals/  Tr2_1 0,Tr2_20,Pls_dur,Tm2_1 0,Tm2_20,Tm2_50,Tm2_80 

1 332  COM  /Time__vals/  Tm2  90 

1 334  COM  /Miscjnt/  INTEGER  No_o_binstHis_zeroJev 

1336  COM  /Miscjnt/  INTEGER  His_1  OOJev.Maxpoint 

1338  COM  /Misc_real/  Delta_v,Delta_v_prc,Ov,Undr 

1340  ! 

1342  INTEGER  Start j)os, Polar 

1 344  REAL  Wvjimp,Wv _top,Wv  base,WvJ O.Wv  _20,Wv_50fWv  8Q,Wv  . 90 
1346  ! 

1348  Typ  - 1 

1 350  CALL  Select_value(Wv_top,Wv_base) 

1352  Wvainp  = Wvtcp-Wvbase 

1354  CALL  Prcnt(Wv_amp,Wv  topfWv_base,VVv_1 0,Wv  20,Wv_50,Wv_80,Wv_90,Ov,Undr,Vmin,Vmax) 

1356  ! 

1358  CALL  Polarity  (Pnts, Polar,  Wave! * ),Wv_1 0,  Wv_90) 

1360  IF  Polar  = -1  THEN 

1362  CALL  Revj)ol(Pnts,Wave(*),Wv_10,Wv_90,Wv  amp,Wv_base) 

1364  END  IF 

1366  ! 

1368  Start_pos  - Maxpoint 

1370  CALL  Fifty  percent(Wave(*),Wv  50,Pnts, Start  pos.Typ) 

1372  \ 

1 374  CALL  Time_oj3rcnt(Wave(#),Wv_50,Tm_50,Pnts,1  ,Start_pos,Typ) 

1 376  CALL  Time_o_prcnt(Wave(*),Wv_10cTm_10,Pnts,-1fStart_posfTyp) 

1 378  CALL  Time_o_prcnt(Wave(*  ),Wv_20,Tm_20,Pnts,~1  ,Stait_pos,TypI 

1 380  CALL  Time_o_prcnt{Wave(*),Wv_80fTm_80,Pnts,1  ,Start_pos,Typ) 

1382  CALL  Timej3j>rcnt(Wave(*),Wv_90,Trn_90,Pnts,1,Start_pos,Typ) 

1384  ! 

1386  Tr1_10=Tm  90-Tm_10 

1 388  Trl  20  =Tm_80-Tm  20 

1390  S 

1 392  Typ  = FNPuls_typ(VJast,  Wv_90) 

1394  IF  Typ  «-1  THEN 

1396  PRINT  "This  is  an  impulse-like  waveform." 

1398  Startj»os  = Maxpoint 

1400  CALL  Fifty _percent(Wave(*),Wv_50,Pnts,Start_pos, Typ) 

1 402  CALL  Time_o_prcnt(Wave(#),Wv_50,Tm2_50,Pnts,1  ,Start_pos,Typ) 

1 404  CALL  Time_o_prcnt(Wave( # ),  Wv_1 0,T m2_1 0,Pnts,  1 „ Start_pos,Ty p) 

1 406  CALL  Time_p_prcnt(Wave(  * ),Wv_20,T m2_20„Pnts,  1 ,Start_pcs,Typ) 

1408  CALL  Time_o_prcnt(Wave(#),Wv_80,Tm2_80,Pnts,'1  fStart_pos,Typ) 

1410  CALL  Time_o_prcnt(Wave(*),Wv_90,Tm2  90,Pnts,-1  ,Start_pos,Typ) 

1412  Tr2_20  =Tm2  20~Tm2ra80 

1414  Tr2  1 0 ~ T m2~1 0-T  m2_90 

1416  P?s  dur  = Tm2_50-Tm_50 

1418  END  IF 

1420  S 

1422  SUBEXIT 

1424  SUBEND 

1426  S 

1428  |**«»***»**»**»**«»***** ****»««***«**#**»*»»«>«**•*#*«♦>*»»**«»** 

1430  ! 

1432  SUB  Write_data(INTEGER  Typ,Dataname$) 

1434  ! 

1 436  Write__data:  ! 

1438  I 

1440  OPTION  BASE  1 
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1 442  RAD 

1444  ! 

1446  COM  /Sys/  Sys_id$[10] 

1 448  COM  /Sysjnsi/  Msi Jd  $ [20] 

1450  COM  /Interrupts/  INTEGER  lntr_prty 

1452  COM  /Volt  vals/  Vmin,Vmax,V_last,Volt  z,Volt_1 00,  V_first,Vptp 
1454  COM /Time  vals/ Tm_10,Tm  20,Tm_507Tm_80fTm_90,Tr1_10,Tr1  20 
1 456  COM  /Time_vals/  Tr2_1 0,Tr2~20,Pls_dur,Tm2  J 0,Tm2_20,Tm2_50,Tm2_80 
1458  COM  /Time_vals/  Tm2  90 

1460  COM  /Misc  int/  INTEGER  No_o_bins, INTEGER  His_zeroJev 
1 462  COM  /Miscjnt/  INTEGER  Hisj"00Jev,Maxpoint 

1 464  COM  /Misc_real/  Delta_v,Delta_v_prc,Ov,Undr 

1466  COM  /Files/” Diskdrive$[20],Filename$[1 4],Ms_path$[500] 

1468  COM  /Units/  X units$[20],Y  units$[20] 

1470  I 

1472  INTEGER  Local_prty,Diskspace 

1474  DIM  Ac$[5],Status$[1  ],Data_id$[40] 

1476  REAL  Dtime 

1478  OFF  KEY 

1 480  Local_prty  = lntr_prty 

1482  Dtime  = 0. 

1484  Underline$  =CHR$(1 32) 

1486  Enhance_off$  =CHR$(1 28) 

1488  I 

1490  Filesize  = 22  ! This  can  be  increased  to  accommodate  more  output. 

1492  ALLOCATE  File$(Filesize)[80] 

1494  INPUT  "Enter  a 40  character  description  of  the  data",Data_id$ 

1496  ! Select  the  disk  drive  for  data  storage 

1498  I 

1 500  Selectdrive:  I 

1502  IF  Diskdrive$  = "NO  DISK"  THEN  Diskdrive$  = "" 

1504  IF  LEN(Diskdrive$)>0  THEN  GOTO  Choosefilename 

1506  GRAPHICS  OFF 

1508  OUTPUT  2 USING  "#,K*;"K" 

1510  CALL  Select_disk 

1512  IF  Diskdrive$  = "NO  DISK"  THEN  GOTO  Mistakeline 

1 514  Choosefilename:  I 

1516  IF  LEN(Filename$)>0  THEN  GOTO  Send_to_disk 

1518  Ac$=  "ABORT" 

1520  CALL  Enterfilename(Ac$) 

1522  IF  LEN(Filename$)  =0  THEN  GOTO  Mistakeline 

1 524  Send_to_disk:  I Create  file  and  save  information. 

1 526  ON  ERROR  GOTO  Cant_savedata 

1528  Diskspace  = INT((82)#Filesize/256) 

1530  I diskspace  = (#  of  characters  in  a line  * # of  lines  in  the  file)/ 

1 532  I the  # bytes  in  a record;  this  gives  # of  records  needed. 

1534  CREATE  ASCII  Filename$&Diskdrive$, Diskspace 

1536  Dtime  = TIMEDATE 

1538  DISP  " SAVING  data  in  file  ";Filename$;"  on  ";Diskdrive$ 

1540  ASSIGN  ©Datapath  TO  Filename$&Diskdrive$ 

1542  OUTPUT  @Datapath;Data_id$  140  chrs  description  of  data 
1 544  OUTPUT  @Datapath;Filesize  Inumber  of  data  strings 
1 546  GOSUB  FilIJile 

1548  OUTPUT  @Datapath;File$(*) 

1 550  ASSIGN  ©Datapath  TO  * 

1552  OFF  ERROR 


B149 


1554  ! 

1 556  Mistakeline:OFF  KEY 
1558  LOOP 

1 560  EXIT  IF  TSMEDATE-Dtime >1.8 

1 562  END  LOOP 

1564  DISP  CHR$(1 2) 

1566  OUTPUT  2 USING  B#,K";"K" 

1568  DEALLOCATE  File$(*) 

1 570  SUBEXIT 

1572  I 

1 574  I //////////////////////////////////////////////////////// 

1576  ! 

1 578  Cant_savedata:  ! 

1580  BEEP  500, .6 

1 582  SELECT  ERRN 

1 584  CASE  72,73,76,78,81 ,82,90,93 

1 586  DISP  Diskdrive$;"  has  failed  or  is  not  available 

1588  DISP  * ....CONTINUE  to  try  again." 

1 590  PAUSE 

1592  Diskdrive$  = 

1594  CASE  84,85 

1596  DISP  " This  disk  is  not  initialized 

1598  DISP  B ....CONTINUE  to  try  again.85 

1 600  PAUSE 

1602  Diskdrive  $ = 

1604  CASE  55,64 

1606  DISP  " This  disk  is  full,  insert  new  floppy  and/or"; 

1608  DISP  " select  new  drive  ...CONTINUE  " 

1610  PAUSE 

1612  Diskdrive  $ = 

1614  CASE  ELSE 

1616  CALL  Errortrap 

1618  IF  LEN (Filename $ ) > 0 THEN  GOTO  Send  tojiisk 

1 620  END  SELECT 

1622  GOTO  Selectdrive 

1 624  Fill  Jile:  ! 

1626  File${1 ) = "The  data  file  is  "&Dataname$&".B 

1 628  File$(2)  = "This  file  is  called  "&Filename$&B." 

1630  File$(31  = "The  10%-90%  first  transition  duration  is  "&VAL$(PROUND(Tr1  J0,-1 3))&" 

"&X  units$&"." 

1632  File  $ (4)  = "The  20%-80%  first  transition  duration  is  "&VAL$(PROUND(Tr1_20,-1 3»)&B 
"&X_units$&\" 

1634  IF  fTyp-~1)  THEN 

1636  File$(5)  = "The  10%-90%  second  transition  duration  is  "&VAL$(PROUND(Tr2J  0,-3))&B 

"&X_units$&"." 

1638  File$(6)  = "The  20%-80%  second  transition  duration  is  "&VAL$(PROUND(Tr2_20,-3))&" 

"&X_units$&B." 

1640  File  $ (7)  = "The  pulse  duration  is  "&VAL$(PROUND(Pls_dur,-3))&"  "&X_units$&"." 

1 642  ELSE 

1644  File$(5)  = 

1646  File$(6)  = "" 

1648  File$(7)  = 

1650  END  IF 

1652  File$(8)  = "The  percentage  overshoot  is  "&VAL$(PROUND(Ov,-2))&"%." 

1654  File$(9)  = "The  percentage  undershoot  is  "&VAL$(PROUND(Undr,-2))&"%." 

1656  File$(101  = "The  waveform  amplitude  is  "&VAL$(PROUND((Volt_100*Volt-z),-3))&"  B&Yjjnits$&B 
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1 658  File$(1 1 ) = "The  maximum  level  is  "&VAL$(PR0UND(Vmax,-3))&"  "&Y_units$&"." 

1660  File$(12)  = "The  minimum  level  is  "&VAL$(PROUND(Vmin,-3))&"  "&Y_units$&\" 

1662  File$(13)  = "There  were  "&VAL$(No_o_bins)&"  bins  used  in  the  histogram." 

1664  File$(14)  = "Each  histogram  bin  is  equivalent  to  "&VAL$(PROUND(Delta_v,-6))&"  "&Y_units$&". 

1666  File$(1 5)  = "or  "&VAL$(PROUND(Delta  v prc,-3))&"%  of  peak  to  peak." 

1668  File$(16)  = "The  0%  histogram  level  is”"&VAL$(PROUND(Volt_z,-3))&"  "&Y_units$ 

1670  File$(17)  = "with  "&VAL$(His  zero_lev)&"  data  occurences." 

1672  File$(18)  = "The  100%  histogram  level  is  "&VAL$(PROUND(Volt_100,-3))&"  "&Y_units$ 

1674  File$(1 9)  = "with  "&VAL$(His  100_lev)&"  data  occurences." 

1676  File$(20)=*"The  peak  to  peakvalue  is  "&VAL$(PROUND(Vptp,-3))&"  "&Y_units$ 

1678  File$(21)  = ’The  first  point  in  the  waveform  is  "&VAL$(PROUND(V  first,-3))&"  "&Y_units$&"." 

1680  File$(22)  = "the  last  point  in  the  waveform  is  "&VAL$(PROUND(VJast,-3))&"  "&Y_units$&"." 

1682  INPUT  "Would  you  like  a print  out  of  the  data  now?",Ch$ 

1 684  IF  (Ch$  = "y")  OR  (Ch$  = "Y")  THEN 

1 686  PRINTER  IS  PRT 

1 688  FOR  1 = 1 TO  Filesize 

1690  PRINT  File$(l) 

1692  PRINT"" 

1694  NEXT  I 

1696  PRINTER  IS  CRT 

1698  END  IF 

1700  RETURN 

1702  ! 

1704  SUBEND 
1706  ! 

1708  ! ******* 

1710  ! 

1712  SUB  Enterfilename(Ac$) 

1714  Enterfilename:  ! Original:  13  Nov  1984 

1716  I Revision:  10  Dec  1990  includes  HFS  directories 

1718  OPTION  BASE  1 

1720  COM  /Files/  Diskdrive$(201,Filename$[14],Ms_path$[500] 

1722  COM  /Interrupts/  INTEGER  lntr_prty 

1724  INTEGER  I, Ascii  num.Maskflag, Namelength 

1726  DIM  Test$[256]7Hfs_temp$[161] 

1728  Namelength  = 1 0 

1730  IF  LEN (Ms_path $ ) > 0 THEN  OUTPUT  KBD  USING  "K,#";"#"&Ms_path$&"H" 

1732  DISP  " ENTER  HFS  directory  PATH  (no  file)"; 

1734  IF  Ac$  < > "PATH"  THEN 

1736  DISP  ",  ENTER  / for  HFS  ROOT  or  null  for  LIF..."; 

1738  END  IF 

1740  LINPUT  Hfs_temp$ 

1742  Hfs_temp$  =TRIM$(Hfs_temp$) 

1744  IF  LEN(Hfs_temp$)>0  THEN 

1746  IF  LEN(Hfs_temp$)>  1 AND  Hfs_temp$[LEN(Hfs_temp$);1  ] < >"/"  THEN 

1748  Hfs  temp$  =Hfs_temp$&"/" 

1 750  END  IF" 

1752  IF  LEN(Hfs_temp$)  = 1 THEN  Hfs_temp$  = "" 

1754  Namelength  = 1 4 

1756  END  IF 

1758  IF  Ac$  = "PATH"  THEN 

1760  Ms_path$  = Hfs_temp$ 

1762  SUBEXIT 

1764  END  IF 

1766  IF  LEN(Filename$)>0  THEN  OUTPUT  KBD  USING  "K,/T;"#"&Filename$&"H" 

1768  Efn:  I 
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1770  DISP  " ENTER  the  FILE  NAME  ...  "; 

1772  SELECT  Ac$ 

1 774  CASE  "CAT" 

1 776  DISP  "(ENTER  CAT  mask*  or  ENTER  null  to  CAT)"; 

1778  CASE  "ABORT- 

1780  DISP  "(ENTER  null  to  ABORT)  \- 

1782  CASE  "VALID" 

1784  DISP  "(must  be  a VALID  name!) 

1786  END  SELECT 

1788  LINPUT  Test$ 

1790  Test$  -TRIM$(Test$) 

1792  IF  LEN(Test$)=0  AND  Ac$  = "VALID"  THEN  GOTO  Enterfilename 

1 794  IF  LEN(TestS)  = 0 THEN  Abortline 

1796  IF  LEN(Test$)>Namelength  THEN 

1798  BEEP 

1800  DISP  "ERROR  in  NAME  ENTRY  - max  ";Namelength;"  chars,  you  have 

1802  DISP  LEN(Test$);"  " 

1804  WAIT  1.8 

1806  OUTPUT  2 USING  "K,#";"#"&Test$&"H" 

1808  GOTO  Efn 

1810  END  IF 

1812  IF  POS(Test$,"®")>1  THEN 

1814  Test$  =Test$[1  ,P0S(Test$fo  * ")-1  ] 

1816  Maskf  lag  - 1 

1818  ELSE 

1820  Maskflag  = 0 

1822  END  IF 

1 824  FOR  1-1  TO  LEN(Test$) 

1826  Ascii_num  = NUM(Test${l]) 

1 828  SELECT  Ascii_num 

1 830  CASE  65  TO  90,95,97  TO  1 22,48  TO  57 

1832  [Allowed  characters 

1 834  CASE  ELSE 

1 836  BEEP 

1838  DISP  “ERROR  in  NAME  ENTRY-ILLEGAL  CHARACTERS,  TRY  AGAIN." 

1840  WAIT  1.8 

1842  OUTPUT  2 USING  "K,#";"#"&Test$&"H" 

1 844  GOTO  Efn 

1 846  END  SELECT 

1 848  NEXT  I 

1 850  IF  Maskflag  THEN 

1852  Filename$  =Test$&"  *" 

1854  ELSE 

1856  Filenames  =Test$ 

1858  END  IF 

1 860  Ms_path$  = Hfs_temp$ 

1862  SUBEXIT 

1 864  Abortline:Filename$  = "" 

1866  IF  Ac$  = "CAT"  THEN  Ms^pathS  =Hfsjemp$ 

1868  SUBEXIT 

1870  SUBEND 


1 874  ! *,****#*#**#*'***#*'s#**'ft®##***#'e's<>*®'&®**®®*<>®***#*'e##c#*'#***'s'e 
1876  ! 

1878  SUB  Select_disk 

1880  Select jjisk:  I Original:  13  Nov  1984 
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1882 

1884 

1886 

1888 

1890 

1892 

1894 

1896 

1898 

1900 

1902 

1904 

1906 

1908 

1910 

1912 

1914 

1916 

1918 

1920 

1922 

1924 

1926 

1928 

1930 

1932 

1934 

1936 

1938 

1940 

1942 

1944 

1946 

1948 

1950 

1952 

1954 

1956 

1958 

1960 

1962 

1964 

1966 

1968 

1970 

1972 

1974 

1976 

1978 

1980 

1982 

1984 

1986 

1988 

1990 

1992 


! Revision:  02  Dec  1987 
OPTION  BASE  1 

COM  /Files/  Diskdrive$l20],Filename$[14],Ms_path$[500] 

COM  /Interrupts/  INTEGER  lntr_prty 
COM  /Sys  msi/  Msi  id$ 

COM  /Sys7  Sys_id$” 

INTEGER  Local_prty,Dd,Pt,Choose(1) 

DIM  Disc$(30)[60],Title$[40],Displ$[601 
Local_prty  = lntr_prty 
OFF  KEY 
I 

I Define  the  disk  drives  available  for  this  system,  reserve  the 
I first  characters  for  the  drive  address  and  the  characters  after 
I the  - for  a description  of  the  drive. 

I 

I Example: 

I Disc$(1 ) = ":,700,0,0  HP  9133H  HARD  disk,  volume  0." 

I 

! 

Displ $ = " SELECT  DISK  DRIVE  ...  Abort  will  cancel.  " 

Title$  = " Available  disk  drives  for  this  system.  " 

Pt  = 1 I allow  only  one  select 
! 

IF  Diskdrive  $[1,1]<>":"  THEN  Diskdrive  $ = "" 

IF  Msijd$[1,1]<  >":"  THEN  Msi  id$  = SYSTEM  $("  MSI") 

IF  Msijd$(1,1]<  >":"  THEN  ! Must  be  HFS  subdirectory 

Ms  path$  =Msijd$l1,POS{Msijd$,":")-1)  I strip  off  subdirs 

IF  Ms  path$(LEN(Ms_path$);1]<  >"/"  THEN  Ms_path$  = Ms_path$&"/" 

Msi  id$  = Msi  id$IPOS(Msi  id$,":"),LEN(Msijd$)] 

END  IF 

Diskdrive$  = TRIM  $ (Diskdrive  $) 

Msi  id  $ = TRIM  $ (Msi  Jd  $ ) 

IF  LEN(Diskdrive$)  >0  AND  LEN(Msi_id$)>0  THEN 
Disc$(1  ) = Diskdrive  $&RPT$("  ",1 7-LEN(Diskdrive$)) 

Disc$(1)  = Disc$(1)&"-  Last  selected  disk  drive." 

Dd  = 1 

IF  Diskdrive$<  >Msi_id$  THEN 

Disc  $ (2)  = Msi  Jd  $ &RPT$  ("  " , 1 7-LEN  (Msi  jd  $ )) 

Disc$(2)  = Disc$(2)&"-  Start-up  mass  storage  unit  specifier." 

Dd  = Dd  + 1 
ELSE 

Disc$(1 ) = Disc$(1  )&"  Start-up  MSUS." 

END  IF 
ELSE 

IF  LEN{Msijd$)>0  THEN 

Disc  $ ( 1 T=  Msi  jd  $ &RPT  $ ("  ",1 7-LEN(Msijd$)) 

Disc$(1 ) = Disc$(1  )&"-  Start-up  mass  storage  unit  specifier." 

Dd  = 1 
ELSE 
Dd  = 0 
END  IF 
END  IF 
Disk:  I 

! customize  system  drives  here 

! Follow  format  with  - after  unit  specifier,  description  is 
I optional  but  recommended. 


B153 


1994 

1996 

1998 

2000 

2002 

2004 

2006 

2008 

2010 

2012 

2014 

2016 

2018 

2020 

2022 

2024 

2026 

2028 

2030 

2032 

2034 

2036 

2038 

2040 

2042 

2044 

2046 

2048 

2050 

2052 

2054 

2056 

2058 

2060 

2062 

2064 

2066 


I 


! 

Disc$(Dd  + 1)  = ":,702,0 
Disc$(Dd  + 2)  = ":,702,  1 
Disc$(Dd  + 31  = 703,0 

Disc$(Dd  + 4)  = 1 400 

I 


- HP  9122  dual  microfloppy  left  drive" 

- HP  9122  dual  microfloppy  right  drive" 

- HP  9125  single  5.25  floppy  drive" 

- HP  9133H  hard  disk  volume  1" 


Dd  ~ Dd  + 4 ! add  the  number  of  drive  specifiers  above 

I 

IF  Sysjd$[1 ,4]  < > "S300"  THEN 

Disc$(Dd  + 1)-":,4,1  - LEFT  internal  series  200" 

Disc$(Dd  + 2)  = ":,4,0  - RIGHT  internal  series  200” 

Dd  ~ Dd  + 2 


END  IF 


I 

CALL  Menu_scroll(Displ$,Title$,Disc$(*),Dd,Pt,Choose(*)) 

IF  Pt-0  THEN 

Diskdriv@$  = "NO  DISK" 

ELSE 

Dd-POS(Disc$(Choose(Pt)),"~")-1  ! find  - 
IF  Dd  > 5 THEN  ! valid  msus 

Diskdrive  $ =TRIM$(Disc${Choose(Pt))[1  .Dd]) 

ELSE 

DISP  " ERROR  in  reading  MSUS  from  string,  - chr  not  found.  B 
BEEP 

CALL  PauseJcey_on 
Oiskdrive$  - "NO  DISK" 

END  IF 
END  IF 

Diskselected:OFF  KEY 
SUBEXIT 
SUBEND 


I *********************************** 

! 

SUB  File_menu(Mask$,Ftype$,Fls$(*),  INTEGER  F I sent,  D i r o n , Prt_o  n ) 


2068  Filejnenu:  ! 


2070  l Original:  29  Jun  1987,  G.  Koepke 

2072  ! Revision:  02  Dec  1987,  07:00 

2074  OPTION  BASE  1 

2076  DEG 

2078  COM  /Sys/  Sysjd$[10] 

2080  COM  /Files/  Diskdrive$(20],Filename${14],Ms_path$[500) 

2082  COM  /Interrupts/  INTEGER  lntr_prty 

2084  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

2086  DIM  Directory$(600H80],Bd$«600)[71] 

2088  DIM  D$[80LT$[51],lds$(40LStat$[1],Test$l2561 

2090  INTEGER  Bd_cnt,File_cnt,l,CDCnt,C0(1  LFormat_error,End_search 

2092  IF  Fls_ent>0  THEN  ALLOCATE  INTEGER  Choose(Fls_cnt) 

2094  ! 

2096  I Catalog  the  disk  specified 

2098  ! 

2100  End_search  = Q 

2102  REPEAT  ! Generate  path  to  file  and  extract  file  name. 

2104  ON  ERROR  GOTO  Caterers 
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2106 

2108 

2110 

2112 

2114 

2116 

2118 

2120 

2122 

2124 

2126 

2128 

2130 

2132 

2134 

2136 

2138 

2140 

2142 

2144 

2146 

2148 

2150 

2152 

2154 

2156 

2158 

2160 

2162 

2164 

2166 

2168 

2170 

2172 

2174 

2176 

2178 

2180 

2182 

2184 

2186 

2188 

2190 

2192 

2194 

2196 

2198 

2200 

2202 

2204 

2206 

2208 

2210 

2212 

2214 

2216 


DISP  " Reading  the  Directory  ...  " 

IF  LEN(Ms_path$)>0  THEN 

MASS  STORAGE  IS  Ms_path$n,LEN(Ms_path$)-1]&Diskdrive$ 
ELSE 

MASS  STORAGE  IS  Diskdrive$ 

END  IF 

CAT  TO  Directory  ${*);NO  HEADER,COUNT  File  cnt 
OFF  ERROR 
I 

I set  up  array  of  legal  file  names. 

I 

Bd  cnt=0 
MAT  Bd$  = (-) 

FOR  I = 1 TO  File  cnt 

SELECT  Directory $(l)[32,36] 

CASE  Ftype$  1 Ftype$  = "BDAT  " or 

I Ftype$  = "PROG  ’ 

IF  LEN(Mask$)>0  THEN  I Test  for  mask$ 

IF  Directory $0)]1,LEN(Mask$)]=Mask$  THEN 
Bd_cnt  = Bd _cnt  + 1 

Bd$(Bd  cnt)  = Directory $(l)[1;14]&"  - "&Ftype$ 

END  IF 
ELSE 

Bd_cnt  = Bd _cnt  + 1 

Bd$(Bd  cnt)  = Directory$0)[1;14]&"  - "&Ftype$ 

END  IF 

CASE  "DIR  " I plus  all  "DIR  " listings 
Bd_cnt  = Bd_cnt  + 1 

Bd$(Bd  cntF=Directory$0)H;14]&"  - DIR  " 

CASE  ELSE 
END  SELECT 
NEXT  I 

IF  LEN(Ms_path$) >0  AND  Bd_cnt>0  AND  Fls_cnt>0  THEN 
Bd _cnt  = Bd_cnt  + 1 

Bd$(Bd_cnt)  = " — MOVE  back  up  ONE  Directory  level." 

Bd  cnt  = Bd_cnt  + 1 

Bd$(Bd  cnt)  = " — RETURN  to  ROOT  Directory." 

END  IF 
I 

I set  up  file  menu 

! . 

D$  " Select  "&VAL$(Fls_cnt)&"  file  name(s)  for  data  entry." 

T $ = "List  of  "&Ftype$&"files  and  DIRs  on  "&Diskdrive$ 

IF  LEN(Mask$)>0  THEN 
T$=T$&"  mask  = "&Mask$ 

END  IF 

IF  Bd_cnt>0  THEN 

IF  Dir  on>0  THEN  GOSUB  ReadjiataJd 
IF  Prt_on  THEN 

GOSUB  List_directory 
End_search  = 1 
ELSE 

C_cnt  = Fls_cnt 
DISP  CHR$(1 2) 

IF  Fls_cnt>0  THEN 

CALL  Menu_scroll(D$,T$,Bd$(*  ),Bd_cnt,C_cnt, Choose!* )) 
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2218 

2220 

2222 

2224 

2226 

2228 

2230 

2232 

2234 

2236 

2238 

2240 

2242 

2244 

2246 

2248 

2250 

2252 

2254 

2256 

2258 

2260 

2262 

2264 

2266 

2268 

2270 

2272 

2274 

2276 

2278 

2280 

2282 

2284 

2286 

2288 

2290 

2292 

2294 

2296 

2298 

2300 

2302 

2304 

2306 

2308 

2310 

2312 

2314 

2316 

2318 

2320 

2322 

2324 

2326 

2328 


ELSE 

CALL  Menu_scrolI(D$,T$fBd$(#),Bd_cnttG_cnt,CO(*)) 

END  IF 

! 

! transfer  file  names  to  Fls$(*). 

I 

IF  C_cnt  - 0 THEN  ! selection  process  aborted 
End  search  - 1 
MAT  Fls$  = ("’) 

ELSE 

MAT  SORT  ChooseC) 

FOR  I = 1 TO  Cjcnt 

IF  Bd$(Choose(l))[1 8P22]  = Ftype$  THEN 
Fls$(l)  = Bd$(Choose{l))[1  ;1 41 
End_search  = 1 

ELSE  l it  must  be  a Directory  or  message. 

SELECT  Bd$(Choose(l))[1 8*22] 

CASE  "up  ON"  ! move  up  one  directory 
LOOP 

Ms_path  $ = Ms_path  $ [ 1 , LEN  (Ms_path  $ )- 1 1 
EXIT  IF  LEN(Ms_path$)  = 0 

Test$  ~ Ms_path$|LEN(Ms_path$);1 1 
EXIT  IF  Test$ 

END  LOOP 

CASE  "ROOT  " ! jump  to  root  directory 
Ms_path$  = "" 

CASE  "DIR  " ! add  directory  to  Ms_path$ 
Test$  = TRIM$(Bd$(Choose(l)H1  *14]) 
Ms_path$  =Ms_path$&Test$&"/" 

CASE  ELSE 

DISP  "ERROR  in  directory  jump" 

PAUSE 
END  SELECT 
S » C cnt 
END  IF 
NEXT  I 
END  IF 
END  IF 
ELSE 

DISP  " This  directory  contains  no  ";Ftype$;"  files  ...  “ 

WAIT  2.5 
End_search  = 1 
END  IF 

DISP  CHR$(1 2) 

UNTIL  End_search 
SUBEXIT 
Cat_errors:l 

DISP  " ERROR  ...  ";ERRM$ 

BEEP 

CALL  Pause  key  on 
DISP  CHR$(1 2)  “ 

C cnt  = 0 
MAT  Fls$  = ("") 

SUBEXIT 

! 

I //////////////////////////////////////////////////// 
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2330  ! 

2332  Read  datajd:  ! This  routine  expects  to  see  lds$  from 
2334  ~ T GRAPH_DATA  raw  data  files. 

2336  DISP  " Reading  file  contents  ...  Please  stand  by.  " 

2338  PRINT  TABXYd,  18);"  Reading  #"; 

2340  FOR  1 = 1 TO  Bd_cnt  ! each  BDAT  file 
2342  PRINT  TABXY(1 1,18); 

2344  PRINT  USING  "3D,4A,3D,2A,#";I,"  of  ",Bd_cnt,".  " 

2346  lds$  = ”Data  not  recognized." 

2348  IF  Bd$(l)[1 8,22]  = "BDAT  " THEN 

2350  ON  ERROR  GOTO  Not  recognized 

2352  ASSIGN  @lo_path  TO"Bd$(l)d  ;14] 

2354  ENTER  @lo_path;Stat$ 

2356  SELECT  Stat$ 

2358  CASE  "N" 

2360  ENTER  @lo_path;lds$ 

2362  CASE  "Y" 

2364  lds$  = "Complete  graph  in  GRAPH_DATA  form." 

2366  END  SELECT 

2368  Not  recognized:ASSIGN  @lo  path  TO  * 

2370  ~ OFF  ERROR 

2372  IF  Dir  on  = 2 THEN 

2374  GOSUB  Interpret _1 

2376  IF  Format_error  THEN  GOTO  Other  format 

2378  GOTO  Go  on 

2380  END  IF 

2382  Other  format:! 

2384  " Bd$(l)l23,71]  = " ...  "&lds$ 

2386  END  IF 

2388  Go  onrNEXT  I 

2390  ” PRINT  TABXY(1 ,1 8);RPT$C  ",40); 

2392  DISP  CHR$(1 2); 

2394  RETURN 

2396  ! 

2398  ! /////////////////////////////////////////////////// 

2400  ! 

2402  Interpret^ : ! This  is  used  to  interpret  ID  strings. 

2404  Format_error  = 1 

2406  ! identify  this  particular  format 

2408  RETURN 

2410  ! 

2412  ! /////////////////////////////////////////////////// 

2414  ! 

2416  List_directory:  ! This  routine  will  provide  a tabular  listing  of 
2418  I the  directory  along  with  lds$  if  provided 

2420  ! 

2422  DISP  " Listing  directory  ...  " 

2424  ON  TIMEOUT  7,10  GOTO  Printer_kaput 

2426  PRINTER  IS  Printer 

2428  PRINT  USING  "//" 

2430  PRINT  T$ 

2432  IF  LEN(Ms  path$)>0  THEN  PRINT  "HFS  Path:  ";Ms_path$ 

2434  PRINT  RPT$("  = ", 80) 

2436  PRINT  "File  name"; 

2438  IF  Dir_on  THEN 

2440  PRINT  " - TYPE  ...  contents" 
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2442  ELSE 

2444  PRINT  " - TYPE" 

2446  END  IF 

2448  PRINT  RPT$("-",80) 

2450  FOR  I = 1 TO  Bd_cnt 

2452  IF  3d$(l)[18,22)  = Ftype$  OR  Bd$(l)[1 8,22]  = "DIR  "THEN 

2454  PRINT  Bd$(l) 

2456  END  IF 

2458  NEXT  I 

2460  PRINT  RPT$("  ",80) 

2462  PRINT 

2464  PRINTER  IS  CRT 

2466  OFF  TIMEOUT  7 

2468  RETURN 

2470  PrinterJcaput:DISP  " Printer  not  responding  ...  listing  aborted.  " 

2472  BEEP 

2474  WAIT  1.8 

2476  OFF  TIMEOUT  7 

2478  RETURN 

2480  SUBEND 
2482  ! 

2484  S *c#®*#**#*®**#***##*****##*®********##*#####****{>®##*#ft**# 

2486  ! 

2488  SUB  Menu_scroll(D$,T$,ltems$(*), INTEGER  ltemj:nt,To_select,Choose{*)) 

2490  Menu_scroll:l  Original:  22  Jun  1987,  Galen  Koepke,  NBS  723.04 
2492  I Revision:  22  Aug  1 990,  1 2:00,  Dennis  Camell 

2494  ! 

2496  I A general  purpose  menu  utility  for  scrolling  items  and 

2498  I selecting  either  a fixed  number  or  a random  number 

2500  I of  items. 

2502  I for  fixed  : To_select  > 0 

2504  ! for  random  : To_select  - -1 

2506  I The  items  are  arranged  in  screens  of  1 5 items  each  and 

2508  l the  user  may  access  screens  via  softkeys.  There  may  be 

2510  I up  to  40  screens  or  600  items  to  choose  from. 

2512  I Maximum  sizes:  D${80],  T${51],  ltems(#)[70] 

2514  ! Items$(*)  contains  the  item  descriptions 

2516  I Item  cnt  is  the  number  of  items  in  ltems$(*} 

2518  ! Choose!*)  is  dimensioned  to  the  number  of  required  choices 

2520  i and  will  be  filled  with  the  item  numbers  chosen. 

2522  I To_select  is  the  number  of  required  choices. 

2524  I 

2526  OPTION  BASE  1 

2528  PRINTER  IS  CRT 

2530  DEG 

2532  GOSUB  Def  j/ariables 

2534  GOSUB  Define_screens 

2536  GOSUB  Make_se!ections 

2538  IF  NulMile  THEN  ! reset  to  zero 

2540  Itemcnt  0 

2542  ltems$«1)  = ”" 

2544  Toselect-0  I no  valid  selections 

2546  END  IF 

2548  SUBEXIT 

2550  ! 

2552  ! //////////////////////////////////////////////////// 
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2554  ! 

2556  Def_variables:! 

2558  COM  /Interrupts/  INTEGER  lntr_prty 

2560  COM  /Bugs/  INTEGER  Bugl  ,Bug2,Bug3, Printer 

2562  COM  /Sys/  Sys  id${10] 

2564  I 

2566  INTEGER  Screen_cnt,ltems_per_scn,FirstJtem(40),Last_item(40) 

2568  INTEGER  l,J,K,FirstJine,Last_line,Active_screen, Pointer,  Last_pt 

2570  INTEGER  Local_prty,Skips,Knobcount,Pointeractive,KO,Null_file 

2572  INTEGER  Exit  flag,Temp,Random_select,lndx 

2574  DIM  Marker$[8],Test$[256] 

2576  ! 

2578  I initialize  parameters 

2580  I 

2582  Local  _prty  = lntr_prty 

2584  IF  Local  prty<1  THEN  Local _prty  = 1 0 

2586  IF  LEN(Sys  id$)  = 0 THEN  Sys_id$  = SYSTEM ${" SYSTEM  ID") 

2588  IF  Item  cnf<  1 THEN 

2590  Nulljile  = 1 

2592  ltem_cnt=  1 

2594  To_select  = 0 

2596  ltems$(1  ) = "***  Empty 

2598  ELSE 

2600  Null_f  ile  = 0 

2602  END  IF 

2604  IF  To_select  = -1  THEN 

2606  Random_select  = 1 ! choose  random  number  of  items 

2608  To  select  = 0 I needed  for  softkeys 

2610  END  IF 

2612  IF  To  select  > Item  cnt  THEN  To_select  = Item  cnt 
2614  MATChoose  = (999) 

2616  Skips  = 0 

2618  Knobcount  = 0 

2620  Donefiag  = 0 

2622  Marker$  = ’ = = = > “&RPT$(CHR$(8),4) 

2624  RETURN 

2626  I 

2628  1 llllllllllllllllllllllllllllllllllllllllllllllllllll 

2630  ! 

2632  Define  screens:!  Set  up  screens  of  1 5 items  each. 

2634  ' ! 

2636  ltems_per_scn  = 1 5 ! Maximum  number  of  displayable  items 

2638  IF  INT(ltem_cnt/ltems_per_scn)  = ltem_cnt/ltems_per_scn  THEN 

2640  Screen  cnt  = INT(ltem_cnt/ltems_per_scn) 

2642  ELSE 

2644  Screen_cnt  = INT(ltem_cnt/ltems  per_scn)  + 1 

2646  END  IF 

2648  J = 1 

2650  FOR  I = 1 TO  Screen_cnt  ! set  up  each  screen 

2652  Firstjtem(l)  =J 

2654  IF  J + ltems_per_scn-1  <ltem_cnt  THEN 

2656  Lastjtem(l)  = J + ltems_per_scn-1 

2658  J = J + ltems_per_scn 

2660  ELSE 

2662  Last  item(l)  = ltem_cnt 

2664  END  IF 
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2666  NEXT  ! 

2668  RETURN 

2670  ! 

2672  ! /////////////////////////////////////////////////// 

2674  ! 

2676  Make.selections:!  MENU  setup  and  use. 

2678  Active.screen  = 1 i first  screen  is  active 

2680  Firstjine  = 2 I first  printed  line  on  screen  - 2 or  greater. 

2682  GOSUB  Write.screen  ! activate  screen  at  Active.screen 
2684  l and  set  First Jine  and  Lastjine  for  Pointer 

2686  ! write  Marker$  to  first  non-selected  line. 

2688  KO  =0  I Keys  start  at  zero 

2690  Exit_flag  = 0 ! allow  ENTER  key  to  exit  when  selections  filled. 

2692  Key  loop:  I 

2694  ON  KBD,Local_prty  GOSUB  Process_kbd 

2696  ON  KNOB  .01  ,Local.prty  GOSUB  Move_pointer 

2698  IF  Random.select  THEN 

2700  I set  keys  for  random  selection 

2702  DISP  D$ 

2704  ON  KEY  KO  LABEL  " SelectMocal.prty  GOSUB  Select_random 

2706  ON  KEY  KO  + 9 LABEL  " Accept",  Loealjirty  GOTO  Exitjne 

2708  ELSE  ! set  key  KO  for  fixed  selection 
2710  IF  Skips  <To_select  THEN 

2712  DISP  B$ 

2714  IF  To  .select  > 1 THEN 

2716  Test$  = " Select  "&VAL$(Skips  + 1)&"  of  "&VAL$(To_select) 

2718  ELSE 

2720  Test$  = " Select" 

2722  END  IF 

2724  ON  KEY  KO  LABEL  Test$,Local_prty  GOSUB  Select.fixed 

2726  ELSE 

2728  IF  Toj»elect>0  THEN 

2730  DISP  " Selection  process  complete  ..." 

2732  ELSE 

2734  DISP  " Menu  for  information  only  ...  " 

2736  END  IF 

2738  ON  KEY  KO  LABEL  " Accept", Local.prty  GOTO  Exitjine 

2740  END  IF 

2742  END  IF 

2744  IF  Active.screen  < Screen.cnt  THEN 

2746  ON  KEY  KO  + 1 LABEL  * Next  Screen  ",Local_prty  GOSUB  Next.screen 

2748  ELSE 

2750  OFF  KEY  KO+1 

2752  END  IF 

2754  IF  Active.screen > 1 THEN 

2756  ON  KEY  KO  + 2 LABEL  " Last  Screen" ,Local_prty  GOSUB  Last.screen 

2758  ELSE 

2760  OFF  KEY  KO  + 2 

2762  END  IF 

2764  IF  Skips  >0  OR  Random  select  THEN 

2766  ON  KEY  KO  + 3 LABEL  " Reset  Select", Local  prty  GOSUB  Selectjeset 

2768  ELSE 

2770  OFF  KEY  KO  + 3 

2772  END  IF 

2774  IF  To_select>0  OR  Random.select  THEN 

2776  ON  KEY  KO  + 4 LABEL  " Abort  ",Local_prty  GOTO  Escape  Jine 
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2778  ELSE 

2780  OFF  KEY  KO  + 4 

2782  END  IF 

2784  IF  Screen_cnt>2  THEN 

2786  ON  KEY  KO  + 6 LABEL  "Jump  to  Screen", Local_prty  GOSUB  Jump_to_scn 

2788  ELSE 

2790  OFF  KEY  KO  + 6 

2792  END  IF 

2794  IF  Exit  flag  THEN  Exit  line 

2796  GOTO~KeyJoop 

2798  Escape  line:Skips=0 
2800  MAT  Choose  = (0) 

2802  To  select =0 

2804  Exit  line:OFF  KEY 
2806  "MAT  SORT  Chooser) 

2808  OFF  KNOB 

2810  OFF  KBD 

2812  OUTPUT  KBD;CHR$(255)&CHR$(75); 

2814  PRINT  CHR$(128); 

2816  ! everything  cleared,  now  go  back  to  work. 

2818  RETURN 

2820  I 

2822  I /////////////////////////////////////////////////// 

2824  ! 

2826  Next  screen:  I 

2828  OFF  KBD 

2830  OFF  KNOB 

2832  OFF  KEY 

2834  IF  Active_screen  = Screen_cnt  THEN  RETURN 

2836  Active_screen = Active_screen  + 1 

2838  GOSUB  Write_screen 

2840  RETURN 

2842  ! 

2844  I /////////////////////////////////////////////////// 

2846  ! 

2848  Last_screen:  I 

2850  OFF  KBD 

2852  OFF  KNOB 

2854  OFF  KEY 

2856  IF  Active_screen  = 1 THEN  RETURN 

2858  Active_screen  = Active_screen-1  , 

2860  GOSUB  Write_screen 

2862  RETURN 

2864  ! 

2866  ! ////////////////////////////////////////////////// 

2868  I 

2870  Jump  to  errors:DISP  " Not  a valid  screen  number  ...  try  again.  " 

2872  BEEP 

2874  WAIT  1.8 

2876  Jump  to_scn:  I 
2878  OFF  KBD 

2880  OFF  KNOB 

2882  OFF  KEY 

2884  DISP  " ENTER  the  screen  number  desired  (1  to  ";Screen_cnt;")."; 

2886  LINPUT  Test$ 

2888  Test$  =TRIM$(Test$) 
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2890  IF  LEN(Test$)  =0  THEN  Jump_to_return 

2892  ON  ERROR  GOTO  Jump_to_errors 

2894  Temp  = INT(VAL{Test$)) 

2896  OFF  ERROR 

2898  IF  Temp<1  OR  Temp>Screen_cnt  THEN  Jump_to_errors 

2900  Aetive_screen = T emp 

2902  GOSUB  Write_screen 

2904  Jump_to_return:  ! 

2906  DISP  CHR$(1 2) 

2908  Test$  »"" 

2910  RETURN 

2912  I 

2914  I ////////////////////////////////////////////////// 

2916  I 

2918  Select  fixed:! 

2920  OFF  KBD 

2922  OFF  KNOB 

2924  OFF  KEY 

2926  IF  NOT  Pointeractive  THEN 

2928  DISP  "NO  additional  selections  for  this  screen.," 

2930  BEEP 

2932  WAIT  2 

2934  DISP  CHR$(12); 

2936  RETURN 

2938  END  IF 

2940  IF  Skips -To_select  THEN 

2942  IF  To  ^select  = 0 THEN 

2944  DISP  "This  menu  is  for  information  only,"; 

2946  DISP  " no  selection  allowed." 

2948  ELSE 

2950  DISP  "All  selections  have  been  filled,"; 

2952  DISP  " 'Select  Reset'  to  repeat." 

2954  END  IF 

2956  BEEP 

2958  WAIT  2 

2960  DISP  CHR$(12); 

2962  RETURN 

2964  END  IF 

2966  Skips  ~ Skips  + 1 

2968  Choose(Skips)  “ First jtem(Active_screen)  + Pointer-Firstjine 

2970  PRINT  CHR$(1 29); , I inverse  video 

2972  PRINT  TABXY(10,Pointer);ltems$(Choose(Skips)) 

2974  f PRINT  CHR$(1 28); 

2976  PRINT  TABXYd, Pointer); 

2978  SELECT  Pointer 

2980  CASE  Firstjine 

2982  GOSUB  Pointjorward 

2984  CASE  Lastjine 

2986  GOSUB  Point_backward 

2988  CASE  ELSE 

2990  ! move  forward  unless  it  requires  wrapping  to  beginning. 

2992  IF  Skips- 1 >0  THEN  I check  for  selected  items, 

2994  I = Pointer-Firstjine 

2996  LOOP 

2998  K -0 

3000  FOR  J = 1 TO  Skips 
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3002 

3004 

3006 

3008 

3010 

3012 

3014 

3016 

3018 

3020 

3022 

3024 

3026 

3028 

3030 

3032 

3034 

3036 

3038 

3040 

3042 

3044 

3046 

3048 

3050 

3052 

3054 

3056 

3058 

3060 

3062 

3064 

3066 

3068 

3070 

3072 

3074 

3076 

3078 

3080 

3082 

3084 

3086 

3088 

3090 

3092 

3094 

3096 

3098 

3100 

3102 

3104 

3106 

3108 

3110 

3112 


IF  First  item(Active_screen)  + l = Choose(J)  THEN  K = 1 
NEXT  J 
EXIT  IF  K = 0 
1 = 1 + 1 

IF  I + First  line  > Last  line  THEN  K = -1 
EXIT  IF  K= -7 
END  LOOP 
IF  K = 0 THEN 

GOSUB  Point_forward 
ELSE 

GOSUB  Point  backward 
END  IF 
ELSE 

GOSUB  Point_forward 
END  IF 
END  SELECT 
RETURN 
! 

I ////////////////////////////////////////////////// 

I 

Select  random:! 

OFF  KBD 
OFF  KNOB 
OFF  KEY 
Test$  = "NO" 

IF  NOT  Pointeractive  THEN 

DISP  "NO  additional  selections  for  this  screen." 

BEEP 
WAIT  2 

DISP  CHR$(1 2); 

RETURN 
END  IF 

FOR  I = 1 TO  To_select 

IF  Choose(l)  = First Jtem(Active_screen)  + Pointer-Firstjine  THEN 
Indx  = I 

Test$  = "YES" 

END  IF 
NEXT  I 

SELECT  Test$ 

CASE  "YES"  ! Selected  item  is  tagged  ...  untag 

IF  Pointer  < >Last  item(Active_screen)  + 1 AND  Pointer  < >17  THEN 
PRINT  CHR$(1 28);!  normafvideo 
ELSE 

PRINT  CHR$(1 32);!  underline  video 
END  IF 

PRINT  TABXY{1 0,Pointer);ltems$(Choose(lndx)) 

FOR  l = lndx  TO  To_select-1 
Choose(l)  = Choose(l  + 1 ) 

NEXT  I 

Choose(To_select)  = 999 
T o_se!ect = T o_select- 1 

CASE  "NO"  ! Selected  item  is  untagged  ...  tag  it 

T o_select = T o_select  + 1 

Choose(To_select)  = First_item(Active_screen)  + Pointer-Firstjine 
IF  Pointer  < >LastJtem(Active_screen)  + 1 AND  Pointer  < > 1 7 THEN 
PRINT  CHR$(1 29);!  inverse"video 
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3114  ELSE 

3116  PRINT  CHR$(133);I  inverse  video  with  underline 

3118  END  IF 

3120  PRINT  TABXY(10,Pointer);ltems$(Choose(To_select)) 

3122  END  SELECT 

3124  PRINT  CHR$(1 28); 

3126  PRINT  TABXYd  pointer); 

3128  RETURN 

3130  I 

3132  I ////////////////////////////////////////////////// 

3134  ! 

3136  Select_reset:  (Clear  Choose  file 

3138  OFF  KBD 

3140  OFF  KNOB 

3142  OFF  KEY 

3144  IF  Random_select  THEN  To_select  = 0 

3146  Skips  = 0 

3148  MAT  Choose  = (999) 

3150  GOSUB  Write_screen 

3152  RETURN 

3154  ! 

3156  I ///////////////////////////////////////////////// 

3158  ! 

3160  Process  kbd:l  Allow  use  of  arrows  and  enter  key  in  addition  to  soft. 
3162  Test$  = KBD$ 

3164  IF  LEN(Test$)  = 1 AND  Test$[1 ,1]  < >CHR$(32)  THEN 
3166  BEEP  80., .1 

3168  RETURN 

3170  END  IF 

3172  IF  Test$[1,1]=CHR$(32)  THEN  GOSUB  Point Jorward 

3174  IF  Test$[1 ,1  ] < >CHR${255)  THEN  RETURN 

3176  SELECT  Test$ [2,2] 

3178  CASE  CHR$(255) 

3180  ! do  nothing 

3182  CASE  "V\"T" 

3184  GOSUB  Point_forward 

3186  CASE 

3188  GOSUB  Point_backward 

3190  CASE  "E\"sVtV&" 

3192  IF  Random_se!ect  THEN 

3194  GOSUB  Select_random 

3196  ELSE 

3198  IF  Skips  <To_select  THEN  ■' 

3200  GOSUB  Selectjixed 

3202  ELSE 

3204  I exit  routine 

3206  Exit_f!ag  = 1 

3208  END  IF 

3210  END  IF 

3212  CASE  ELSE 

3214  BEEP  80.,.  1 

3216  END  SELECT 

3218  Test$  - 

3220  RETURN 

3222  I 

3224  ! ////////////////////////////////////////////////// 
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3226  ! 

3228  Point_forward:Knobcount  = 5 
3230  GOSUB  Move_pointer 

3232  RETURN 

3234  PointJ)ackward:Knobcount  = -5 
3236  GOSUB  Movejjointer 

3238  RETURN 

3240  ! 

3242  ! ////////////////////////////////////////////////// 

3244  ! 

3246  Jog_pointer:l  Move  the  selection  pointer  on  the  active  screen. 

3248  I without  regard  to  selected  values 

3250  IF  Knobcount>0  THEN  I Move  forward 

3252  Pointer = Pointer  + 1 

3254  ELSE  I Move  backward 

3256  Pointer*  Pointer- 1 

3258  END  IF 

3260  IF  Pointer  < First Jine  THEN  Pointer  - Last Jine 

3262  IF  Pointer  > Last  line  THEN  Pointer  = First  line 

3264  RETURN 

3266  I 

3268  ! ///////////////////////////////////////////////////////// 

3270  ! 

3272  Move_pointer:!  Control  pointer  to  avoid  re-selection  of  items 

3274  IF  NOT  Pointeractive  THEN  RETURN  1 No  selections  to  be  made. 

3276  Knobcount  = Knobcount  + KNOBX-KNOBY 

3278  IF  ABS(Knobcount)  < 4 THEN  RETURN 

3280  Last j)t  = Pointer 

3282  GOSUB  Jog  pointer 

3284  IF  Skips  >0  THEN 

3286  LOOP 

3288  J = Pointer-First  Jine 

3290  FOR  1 = 1 TO  Skips 

3292  IF  First  item(Active_screen)  + J = Choose(l)  THEN  J = 999 

3294  NEXT  I 

3296  IF  J = 999  AND  Pointer  = LastjJt  THEN  Pointeractive  = 0 

3298  EXIT  IF  Pointeractive  = 0 

3300  IF  J = 999  THEN  GOSUB  Jog jjointer 

3302  EXIT  IF  J<  >999 

3304  END  LOOP 

3306  END  IF 

3308  Knobcount  -0 

3310  OUTPUT  KBD;CHR$(255)&CHR$(84);  ! Bring  screen  home 

3312  IF  Last_pt  = Lastjine  THEN  PRINT  CHR$(132); 

3314  PRINT  " 

3316  IF  Pointeractive  THEN  ! Pointer  active 

3318  IF  Pointer  = Last  Jine  THEN 

3320  PRINT  CHR$(1 32); 

3322  ELSE 

3324  PRINT  CHR$(1 28); 

3326  END  IF 

3328  PRINT  TABXY(1  ,Pointer);Marker$;CHR$(1 28); 

3330  END  IF 

3332  RETURN 

3334  ! 

3336  i ////////////////////////////////////////////////// 
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3338  I 

3340  Write_screen:l  Write  the  screen  pointed  to  by  Active_screen 
3342  ! home  and  clear  screen 

3344  OUTPUT  KBD;CHR$(255)&CHR$(84)&CHR$(255)&CHR$(75); 

3346  Knobcount  = KNOBX-KNOBY  ! Clear  knob  and  keyboard 
3348  Knobcount  = 0 

3350  Test$  =KBD$ 

3352  Test$ 

3354  ! 

3356  PRINT  TABXYtl  ,FirstJine-1  );CHR$«1 32);"  Item  #1  Screen 

3358  PRINT  USING  •#,2D,4A,2Df3A";Active_screen,"  of  ";Screen_cnt;"  | " 

3360  PRINT  T$;RPT$C  ",51-LEN(T$)); 

3362  PRINT  TABXY(80, First Jine-1 | ";CHR$n  28); 

3364  J = 0 

3366  REPEAT 

3368  IF  J~LastJtem(Active_screen)-FirstJtem(Active_screen)  THEN 

3370  PRINT  CHR$(1 32); 

3372  PRINT  TABXY(  1, First  Jine + J);RPT$("  "#80) 

3374  ELSE 

3376  PRINT  CHR$(1 28); 

3378  END  IF 

3380  PRINT  TABXY(5fFirst_line  + J); 

3382  PRINT  USING  "3D,A,#";FirstJtem(Active_screen)  -f  J,"  i " 

3384  IF  Random^select  THEN 

3386  FOR  I - 1 TO  To_select 

3388  IF  FirstJtem(Active_screen)  + J -Choosed)  THEN 

3390  PRINT  CHR$(1 29); 

3392  END  IF 

3394  NEXT  I 

3396  ELSE 

3398  IF  Skips  >0  THEN  I make  this  line  inverse  video 

3400  FOR  1 = 1 TO  Skips 

3402  IF  First Jtem(Active_screen)  +J  -Choose(l)  THEN 

3404  PRINT  CHR$(1 29); 

3406  END  IF 

3408  NEXT  I 

3410  END  IF 

3412  END  IF 

3414  PRINT  TABXYH  0, First  Jine  + J);ltems$(First_item(Active_screen)  + J) 

3416  PRINT  TABXY(80eFirstJine  + J);"  | °; 

3418  J^J  + 1 

3420  UNTIL  J > = (LastJtem(Active_screen)-First_item(Active_screen)  + 1 ) 
3422  Lastjine  = LastJtem(Active_screen)-FirstJtem(Active_screen) 

3424  Lastjine  = Lastjine  + First Jine 

3426  I 

3428  ! set  marker  to  first  non-selected  item. 

3430  \ 

3432  Pointeractive  = 0 

3434  IF  To_select>0  OR  Random_select  THEN  Pointeractive  = 1 

3436  IF  Skips  >0  AND  Pointeractive  = 1 THEN  ! find  first  non-selected  item 

3438  J 0 

3440  LOOP 

3442  Pointer  = First  Jine  + J 

3444  FOR  1 = 1 TO  Skips 

3446  IF  FirstJtem(Active_screen)  + J = Choose(l)  THEN  Pointer  = 0 

3448  NEXT  I 
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3450  EXIT  IF  Pointer <>0 

3452  J=J  + 1 

3454  IF  First_line  + J>LastJine  THEN 

3456  Pointeractive = 0 

3458  Pointer  = First  line 

3460  END  IF 

3462  EXIT  IF  Pointer  < >0 

3464  END  LOOP 

3466  ELSE 

3468  Pointer  = First  line 

3470  END  IF 

3472  IF  Pointeractive  THEN 

3474  if  Pointer  = Last  line  THEN 

3476  PRINT  CHR$(1 32); 

3478  ELSE 

3480  PRINT  CHR$(1 28); 

3482  END  IF 

3484  PRINT  TABXYd  ,Pointer);Marker$;CHR$(1 28); 

3486  END  IF 

3488  RETURN 

3490  SUBEND 
3492  I 

3494  I * 

3496  I 

3498  SUB  Errortrap 
3500  Errortrap:  I Original:  1 3 Nov  1 984 
3502  ! Revision:  02  Dec  1 987 

3504  I Trap  most  errors  here 

3506  OPTION  BASE  1 

3508  COM  /Files/  Diskdrive$l201,Filename$[14],Ms_path$l500] 

3510  DIM  File$[20],Test$[256],What$[201,Ac$[5]  “ 

3512  BEEP  400, .6 

3514  SELECT  ERRN 

3516  CASE  54 

3518  DISP  "DUPUCATE  FILE  NAME:  ";FHename$; 

3520  DISP  "....PURGE  old  one?  (Y/N)"; 

3522  LINPUT  What$ 

3524  What  $=  TRIM  $(  What  $) 

3526  SELECT  What$[1,1] 

3528  CASE  "Y","y" 

3530  PURGE  Ms_path$&Filename$&Diskdrive$ 

3532  CASE  ELSE 

3534  Ac$  = "VALID" 

3536  CALL  Enterfilename(Ac$) 

3538  END  SELECT 

3540  CASE  52,53 

3542  DISP  "Improper  FILE  NAME  — ENTER  NEW  FILE  NAME"; 

3544  OUTPUT  2 USING  "#,K,K";"#";Filename$ 

3546  UNPUT  Filename$ 

3548  Filename$  =TRIM$(Filename$) 

3550  CASE  56 

3552  DISP  "FILE:  ";Filename$;"  is  not  on  this  disk,  please  insert"; 

3554  DISP  " correct  disk" 

3556  CALL  Pause  key_on 

3558  CASE  64 

3560  DISP  "This  disk  is  full,  PLEASE  insert  clean  disk" 
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3562  CALL  Pausekeyon 

3564  CASE  56 

3566  DISP  "DATA  INPUT  disk  must  be  in  drive!! 

3568  DISP  "...CONTINUE  when  ready." 

3570  CALL  Pause_key_on 

3572  CASE  72,73,76 

3574  DISP  Diskdrive$; 

3576  DISP  " is  not  available,  type  correct"; 

3578  DISP  " unit  specifier  (ie.  707,0')."; 

3580  OUTPUT  2 USING  "K,#";Diskdrive$ 

3582  LINPUT  Diskdrive$ 

3584  CASE  80 

3586  DISP  "CHECK  DISK  drive  door!" 

3588  CALL  PauseJ*ey_on 

3590  CASE  ELSE 

3592  DISP  ERRM$;“  'CONTINUE'  when  fixed" 

3594  CALL  Pause  key  on 

3596  END  SELECT 

3598  DISP  CHR$(1 2) 

3600  SUBEXIT 

3602  SUBEND 
3604  ! 

3606  I **** * * * * * * * * * * * * * * * * * * * * * * * * * * * • 9 * * * * * * * * 6 * * * * 8 * * 1 

3608  ! 

3610  SUB  LoadjJisk_data(Basket_file(*), INTEGER  Basketsize,  Data  jd$) 

3612  Load_disk_data:  I Original:  13  Nov  1984 
3614  ! Revision:  02  Dec  1987 

3616  IThis  routine  will  enter  data  files  from  the  disk 

3618  OPTION  BASE  1 

3620  ! 

3622  COM  /Sys/  Sysjd$ 

3624  COM  /History/  Status$n],Time_orgn${8],Date_orgn$(1 11 

3626  COM  /History/  Time_chng$[8],Date_chng$(1 1],Description$[1601 

3628  ! 

3630  COM  /Labels/  Labels$(30»[60],INTEGER  Lbl_count,REAL  Lb!_addr(30,6) 
3632  ILbl  addr:  x,  y,  pen,  size,  LDIR,  LORG 
3634  ! 

3636  COM  /Data_param/  INTEGER  Datacount,Filesize,Curvecount, Roster!  17,4) 
3638  COM  /Data  param/  REAL  Sym__size,Symbol$(17)l2],CurveJd$(17)[40] 

3640  COM  /Datajjaram/  REAL  Xmin_data,Xmax_data 

3642  COM  /Data_param/  REAL  Ymin_data,Ymax_data 

3644  ! 

3646  IRoster:  Curve#,  Start  Addr  in  File!*),  Datacount,  and  PEN 
3648  !Symbol$(i)  = ""  or  "Y"  = > no  symbol,  connect  pts 
3650  !Symbol$(i)  = "*Y"  =>  * symbol,  connect  pts 
3652  !Symbol$(i)  = "*N"  =>  * symbol,  do  not  connect  pts 
3654  ! 

3656  COM  /Background/  Graphtype$[12],Margins$(2)[10],Papersize${1] 

3658  COM  /Background/  REAL  Pen_speed, INTEGER  Backgnd_pen,Auto_time 

3660  COM  /Background/  INTEGER  Auto_file,REAL  X_crossjy,Y_cross_x 

3662  COM  /Background/  Xgrid_tick$[41, INTEGER  Xmajor,Xminor 

3664  COM  /Background/  Ygrid_tick$[4], INTEGER  Ymajor,Yminor 

3666  COM  /Background/  REAL  Xmin_graph,Xmax_graph,Yminjjraph,Ymax_graph 
3668  ! 

3670  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

3672  COM  /Interrupts/  INTEGER  lntr_prty 
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3674  COM  /Enlarge_file/  INTEGER  Overflow 

3676  COM  /Files/  Diskdrive$[20],Filename$(141,Ms_path$[500] 

3678  ! 

3680  INTEGER  R.Hold  size, Local_prty, Allocated, Fls_cnt 

3682  DIM  Ac$[5],Tempfile$[1 0],Mask$t1 01,Ftype$[5],Fls$(1  )[1 0] 

3684  REAL  Dtime 

3686  OFF  KEY 

3688  Local  prty  = lntr  prty 

3690  ! 

3692  ISelect  the  disk  drive  where  the  data  exists 
3694  I 

3696  IF  Overflow  < > 0 THEN  Overflow  = 0 
3698  Hold_size=0 

3700  Dtime  = 0. 

3702  Allocated  =0 

3704  Selectdrive:  I 

3706  IF  Diskdrive  $ = "NO  DISK"  THEN  Diskdrive$  * 

3708  IF  LEN(Diskdrive$)>0  THEN  GOTO  Choosefilename 

3710  GRAPHICS  OFF 

3712  OUTPUT  2 USING  "#,K";"K" 

3714  CALL  Select_disk 

3716  IF  Diskdrive$  = "NO  DISK"  THEN  GOTO  Mistakelineset 
3718  Choosefilename:  ! 

3720  Tempfile$  =Filename$ 

3722  IF  LEN(Filename$) >0  THEN  GOTO  Bring_in_data 

3724  Ac$  = "CAT" 

3726  CALL  Enterfilename(Ac$) 

3728  IF  LEN(Filename$)  = 0 OR  POS(Filename$,"#")>  1 THEN 
3730  IF  POS(Filename$,"  * ")  > 1 THEN  ! set  mask$ 

3732  Mask$  = Filename$[1,POS(Filename$,"#")-1] 

3734  Filename$  = "" 

3736  ELSE 

3738  Mask$  = ""l  no  preselection 

3740  END  IF 

3742  Ftype$  = "BDAT  " I examine  BDAT  files  only 

3744  Fls_cnt  = 1 I select  one  file 

3746  Intr^prty  = Local_prty  + 1 

3748  CALL  File_menu(Mask$,Ftype$,FIs$(#),Fls_cnt,0,0) 

3750  Intr _prty  - Local  jjrty 

3752  Filename$  =Fls$(1) 

3754  IF  LEN(Filename$)  =0  THEN  ! aborted 

3756  Filename$  =Tempfile$ 

3758  GOTO  Mistakelineset 

3760  END  IF 

3762  END  IF 

3764  Bring  in_data:  I 
3766  f 

3768  IFind  this  file  on  the  disk. 

3770  ! 

3772  ON  ERROR  GOTO  Cant_findfile 

3774  ASSIGN  (©Datapath  TO  Filename$&Diskdrive$ 

3776  OFF  ERROR 

3778  Dtime  = TIMED  ATE 

3780  DISP  " LOADING  disk  file:  ";FiIename$;"  ...  "; 

3782  ON  ERROR  GOTO  Bad_file 

3784  ENTER  @Datapath;Status$ 
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3786 

3788 

3790 

3792 

3794 

3796 

3798 

3800 

3802 

3804 

3806 

3808 

3810 

3812 

3814 

3816 

3818 

3820 

3822 

3824 

3826 

3828 

3830 

3832 

3834 

3836 

3838 

3840 

3842 

3844 

3846 

3848 

3850 

3852 

3854 

3856 

3858 

3860 

3862 

3864 

3866 

3868 

3870 

3872 

3874 

3876 

3878 

3880 

3882 

3884 

3886 

3888 

3890 

3892 

3894 

3896 


OFF  ERROR 

ON  ERROR  GOTO  Cantjindfile 
SELECT  Status  $ 

CASE  "Y"  ! All  graphics/data  parameters  exist.REN  100,2 

DISP  " Complete  graph.  " 

ENTER  @Datapath;Time_orgn$fDate_orgn$ 

ENTER  @Datapath;Time_chng $ ,Date_chng $ 

ENTER  @Datapath;Description$ 

ENTER  @Datapath;Labels  $ ( * ) , Lbl_count,Lbl_addr(  * ) 
ENTER  @Datapath;Curve  Jd $ { * ),Sy mbol $ ( *7 
ENTER  @Datapath;Roster(  * ),Curvecount 
ENTER  @Datapath;G  raphty  pe  $ , Margins  $ ( * ) 

ENTER  @Datapath;X_cross_y,Y_cross_x 
ENTER  @Datapath;Xgrid_tick$  ,Xmajor,Xminor 
ENTER  @Datapath;Ygrid_tick$,Ymajor,Yminor 
ENTER  @Datapath;Xmin_graph,Xmax_graph 
ENTER  @Datapath;Ymin_graph,Ymax_graph 
CASE  "N"  ! Only  data  parameters  exist. 

DISP  " RAW  data.  ’ 

CASE  ELSE 

Badjile:  DISP  CHR$(12) 

DISP  “Data  file  is  not  recognized,  entry  aborted."; 

DISP  " ...continue." 

BEEP 
PAUSE 
OFF  ERROR 
GOTO  Mistakelineset 
END  SELECT 
! 

ENTER  @Datapath;Datajd$ 

ENTER  @Datapath;Datacount 
ENTER  @Datapath;Hold_size 
IF  NOT  Allocated  THEN 

IF  Datacount>  - 1 AND  Hold_size>  = 1 THEN 
ALLOCATE  Holding_file(Hold  size,2) 

ELSE 

ALLOCATE  Holdingjiled  ,2) 

END  IF 
Allocated  - 1 
END  IF 

ENTER  @Datapath;HoldingJiled) 

ASSIGN  ©Datapath  TO  * ‘ 

OFF  ERROR 

IF  Datacount  = 0 THEN  Mistakeline 
! 

ICopy  data  from  Holding_file(*)  to  Basket_file(*) 

! 

MAT  BasketJ ile  = (0.) 

IF  Datacount>Basketsize  THEN  (Receiving  file  too  small. 
Allocated  = 0 

DEALLOCATE  Holdingjiled) 

DISP  B DATA  FILE  overflow,  new  data  discarded. 

DISP  “ (continue)  " 

BEEP 

PAUSE 

IF  Status$  = "Y"  THEN 
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3898  Curvecount=0 

3900  MAT  Roster=  (0) 

3902  END  IF 

3904  Overflow  = Hold_size 

3906  GOTO  Mistakelineset 

3908  END  IF 

3910  Copydatafile:  I 

3912  FOR  R=*1  TO  Datacount 

39 1 4 Basket _file(R,  1 ) = Holding  Jile(R,  1 ) 

3916  Basket  file(R,2)  — Holding  file(R,2) 

3918  NEXT  R 

3920  Basketsize  = Datacount 

3922  GOTO  Mistakeline 

3924  I 

3926  Mistakelineset: Basketsize =0 
3928  Mistake!ine:OFF  KEY 

3930  IF  Allocated  THEN  DEALLOCATE  Holding  filer ) 

3932  LOOP 

3934  EXIT  IF  TIMEDATE-Dtime >1.8 

3936  END  LOOP 

3938  DISP  CHR$(1 2) 

3940  OUTPUT  2 USING 

3942  SUBEXIT 

3944  I 

3946  1 //////////////////////////////////////////////////////// 

3948  I 

3950  Cant  findfile:  lError  in  searching  for  the  file. 

3952  BEEP  500, .6 

3954  SELECT  ERRN 

3956  CASE  56 

3958  DISP  "That  file  does  not  exist  on  this  disk 

3960  CASE  72,73,76,82 

3962  DISP  Diskdrive$;”  has  failed  or  is  not  available 

3964  CASE  ELSE 

3966  DISP  ERRM$; 

3968  END  SELECT 

3970  DISP  " ....CONTINUE  to  try  again." 

3972  PAUSE 

3974  Filename$  = "" 

3976  Diskdrive$  = "" 

3978  GOTO  Selectdrive 

3980  I 

3982  SUBEND 
3984  ! 

3986  I 
3988  ! 
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B.5  GAUSS 


100  I RE-STORE  "GAUSS:,  1400" 

102  ! 

104  COM  /Sys/  Sysjd$[101 
106  COM  /Sys  msi/  Msijd$[20] 

108  ! 

110  OUTPUT  KBD  USING  "K,#";"SCRATCH  KEYE"  I ERASE  SOFT  KEYS 
1 1 2 CONTROL  KBD,1 5;0!  sets  the  color  of  the  soft  keys 
114  CONTROL  KBD,2;1 
116  ! 

118  Sntr_prty  = 1 
1 20  CLEAR  SCREEN 
1 22  CALL  Gauss 
124  ! 

126  OUTPUT  KBD  USING  "K,#";"LOAD  KEYE"!  restore  the  typing  aid  keys 
1 28  PRINT  TABXYfl  ,5);"END  of  program.  So  long." 

130  MASS  STORAGE  IS  1400* 

132  ! 

1 34  END 
136  ! 

138  ! 

140  ! 

142  SUB  Gauss 
144  ! 

146  Gauss:  ! 

148  OPTION  BASE  1 

150  COM  /Files/  Diskdrive$l20],Filename$[14],Ms_path$[5001 

152  COM  /Interrupts/  INTEGER  IntrjDrty 

154  ! 

156  i Declare  variables 

158  INTEGER  Fs,Ptn,Filesize,Datacount,Num 

160  REAL  Sigma,Pulse__amp,Time_window,Wv(32767,2),Time_var„Temp 
162  DIM  Data  id $[40] 

164  ! 

1 66  I Give  information  and  ask  for  a value  of  sigma 

168  PRINT  "This  program  produces  an  impulse-like,  Gaussian  waveform." 

170  PRINT  "You  will  need  to  input  a value  for  sigma." 

172  ! 

174  GOSUB  Sigmajn 

176  ! 

178  GOSUB  Num_pnts 

180  REDIM  Wv(Num,2) 

182  ! 

1 84  I We  want  to  create  a gaussian,  so  starting  from  the  equation 
186  ! for  a gaussian  exp(-0.5  (x/sigmap“2  ) we  find  the  value  of  the 

1 88  I FWHM.  At  this  point  0.5  = exp(-0.5  ((x-mean)/sigma)^fe2)  so 

190  ! [HALF  MAX]  = 0.693147181  = (-0.5)  * ((x  - mean)/sigma)~2  and 

192  ! (x  - mean)  * 2 * 1.17741  * sigma. 

194  ! 

196  PRINT  "For  this  sigma,  full  width-half  max  - ",2„35482*Sigma 

198  ! 

200  ! Compute  the  pulse  amplitude 

202  I 

204  GOSUB  Pisamp 
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206  ! 

208  1 Ask  for  the  time  window  in  seconds  and  ask  for  the  filename 

210  ! 

212  GOSUB  Get  wndow 

214  ! 

216  (Calculate  the  standard  normalizing  factor  for  gaussian 

218  I 

220  Dt = Time_window/Num 

222  Time_var =0. 

224  Two  sig_squared  = 2.0*  Sigma*  Sigma 
226  IF  (1 0.729*Sigma/Dt  + .5)  > 32767  THEN 

228  DISP  "The  calculation  cannot  be  completed  as  requested.  Please” 

230  WAIT  1 .0 

232  DISP  ”check  your  numbers  and  run  the  program  again.” 

234  SUBEXIT 

236  ELSE 

238  Ptn  = INT(1 0.729*Sigma/Dt  + .5}  + 1 

240  (Calculate  the  points  in  the  gaussian 

242  END  IF 

244  I 

246  FOR  1 = 1 TO  Num 

248  Exponent  = (O-Ptn)  * (l-Ptn)  * Dt  * Dt/Two_sig_squared) 

250  IF  Exponent >57.56  THEN 

252  Wv(l,2)  =0. 

254  ELSE 

256  Wv(l,2)  = Pulse  amp*EXP(-Exponent) 

258  END  IF 

260  Wv(l,1)  =Time_var 

262  Time  var  = Time  var  + Dt 

264  NEXT  I " 

266  I 

268  Filesize  = Num 

27 0 Datacount  = Num 

272  Filename$  = "" 

274  Diskdrive$  = "" 

276  Data  id$  = "Gaussian  waveform" 

278  ! 

280  CALL  Data_to_disk_r(Wv(*),Filesize, Datacount, Data_id$) 

282  I 

284  (Exit  the  subroutine 

286  I 

288  CLEAR  SCREEN 

290  SUBEXIT 

292  Sigma_err:  I 
294  BEEP 

296  DISP  "ERROR  IN  VALUE  OF  SIGMA.  TRY  AGAIN." 

298  WAIT  1 .0 

300  Sigma  in:  I 

302  ON  ERROR  GOSUB  Sigma_err 

304  Test$  = "" 

306  INPUT  "Please  enter  a value  for  sigma:  ",Test$ 

308  IF  LEN(Test$)  < 1 THEN  GOTO  Sigma_err 
310  CALL  Data_check(Test$) 

312  Sigma  = VAL(Test$) 

314  OFF  ERROR 

316  IF  Sigma  < = 0 THEN  GOTO  Sigma_err 
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318  RETURN 

320  Num_err:  ! 

322  BEEP 

324  DISP  "ERROR  IN  THE  NUMBER  OF  POINTS,  TRY  AGAIN* 

326  WAIT  1 .0 

328  Num_pnts:  I 
330  Test$  = 

332  ON  ERROR  GOTO  Numjjrr 

334  INPUT  "Enter  an  integer  number  for  the  points  in  the  waveform ?",Test$ 

336  IF  LEN(Test$)<  1 THEN  GOTO  Num  err 

338  Temp-VAL(Test$) 

340  OFF  ERROR 

342  IF  (Temp<  =0)  OR  (INT(Temp)<  >Temp)  THEN  GOTO  Nunrjerr 

344  Num  = INT(Temp) 

346  RETURN 

348  Amplerr:  I 

350  BEEP 

352  DISP  "INPUT  ERROR,  PLEASE  TRY  AGAIN," 

354  WAIT  1 ,0 

356  Pls_amp:  ! 

358  ON  ERROR  GOTO  Amp!  err 

360  Inp:  Testes’5" 

362  INPUT  “Would  you  like  a unit  area  pulse?  y/n  (default  is  y|,‘5,Test$ 

364  IF  LEN(Test$)  < 1 THEN  Test$  - V 

366  I 

368  IF  (Test$  < > "y")  AND  (Test$  < > T)  AND  (Test$  < > "NB)  AND  (Test$  < > "n")  THEN 

370  BEEP 

372  DISP  "I  don't  understand,  please  try  again.  This  time  answer  y/n," 

374  WAIT  1 ,0 

376  GOTO  Inp 

378  END  IF 

380  OFF  ERROR 

382  IF  (Test$  = "Y")  OR  «Test$  * "y")  THEN 

384  Pulse  jimp  = 1 ,0/(SQRT(2.0  # PI)  * Sigma) 

386  ELSE 

388  GOSUB  Input^amp 

390  END  IF 

392  RETURN 

394  Pnt_err:  ! 

396  ^ BEEP 

398  DISP  "INPUT  ERROR,  PLEASE  TRY  AGAIN," 

400  WAIT  1 .0 

402  Point_place:  ! 

404  ON  ERROR  GOTO  Pntjirr 

406  INPUT  *At  what  point  would  you  like  the  maximum  to  occur?  \Test$ 

408  IF  LEN(Test$)<  1 THEN  GOTO  Pntjsrr 

410  Temp  = VAL(Test$) 

412  OFF  ERROR 

414  IF  (Temp<  =0)  OR  (INT(Temp)<  >Temp)  THEN  GOTO  Pnt_err 

416  Ptn~!NT(Temp) 

418  RETURN 

420  Window^err:  ! 

422  BEEP 

424  DISP  "TIME  WINDOW  INPUT  ERROR,  PLEASE  TRY  AGAIN," 

426  WAIT  1.0 

428  Getjvndow:  ! 
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430  ON  ERROR  GOTO  Window_err 

432  Test$  = "" 

434  INPUT  "What  is  the  time  window  in  seconds?  ",Test$ 

436  IF  LEN(Test$)<  1 THEN  GOTO  Window_err 
438  CALL  Data_check(Test$) 

440  Time_window  = VAL(Test$) 

442  IF  Time_window  < =0  THEN 

444  DISP  "Time  window  must  be  greater  than  zero." 

446  WAIT  1 .0 

448  GOTO  Window  err 

450  END  IF 

452  OFF  ERROR 

454  RETURN 

456  lnp_amp  err:  I 

458  BEEP 

460  DISP  "INPUT  ERROR,  PLEASE  TRY  AGAIN." 

462  WAIT  1 .0 

464  lnput_amp:  ! 

466  ON  ERROR  GOTO  Inp  amp_err 

468  Test$  = "" 

470  INPUT  "Enter  in  the  desired  pulse  amplitude.", Test  $ 

472  IF  LEN(Test$)<  1 THEN  GOTO  lnp_amp_error 

474  CALL  Data_check(Test$) 

476  Pulse_amp=VAL(Test$) 

478  IF  Pulse_amp  = 0 THEN  GOTO  lnp_amp_err 

480  OFF  ERROR 

482  RETURN 

484  SUBEND 

486  ! 

488  imiuiimiii 

490  SUB  Data_to_disk_r(REAL  File! *), INTEGER  Fiiesize,Datacount,DataJd$) 
492  Data_to_disk_r:  I Original:  1 3 Nov  1 984 

494  I Revision:  06  Aug  1 987 

496  I This  routine  will  SAVE  data  files  on  the  disk  in  RAW  data  format. 
498  ! Special  features: 

500  I If  the  Diskdrive$  and/or  the  Filename$  are  null  this  routine 
502  l will  prompt  the  operator  for  information.  However,  if  they 

504  I are  not  null  it  is  assumed  that  the  program  is  supplying  the 

506  ! correct  information. 

508  I 

510  OPTION  BASE  1 . 

512  COM  /Files/  Diskdrive$[20],Filename$[141,Ms_path$[500) 

514  COM  /Interrupts/  INTEGER  lntr_prty 

516  INTEGER  Local_prty,Diskspace 

518  DIM  Ac$[5],Status$[1] 

520  REAL  Dtime 

522  OFF  KEY 

524  Local_prty  = lntr_prty 

526  Dtime  = 0. 

528  I 

530  (Select  the  disk  drive  for  data  storage 

532  ! 

534  Selectdrive:  ! 

536  IF  Diskdrive$  = "NO  DISK"  THEN  Diskdrive$  = "" 

538  IF  LEN(Diskdrive$)>0  THEN  GOTO  Choosefilename 

540  GRAPHICS  OFF 
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542  OUTPUT  2 USING  "#,K";"K" 

544  CALL  Select_disk 

546  IF  Diskdrive$  = "NO  DISK"  THEN  GOTO  Mistakeline 
548  Choosefilename:  ! 

550  IF  LEN(Filename$)  > 0 THEN  GOTO  Send_to„disk 

552  Ac$  - "ABORT*5 

554  CALL  Enterfilename(Ac$) 

556  IF  tEN(Fiiename$|  ^0  THEN  GOTO  Mistakeline 

558  Send_to_dislc  I Create  file  and  save  information. 

560  ON  ERROR  GOTO  Cant_savedata 

562  Diskspace  = INT((Filesize#  1 6.0)/256|  + 2 

564  CREATE  BDAT  Filename$&Diskdrive$, Diskspace, 256 

566  Dtime  = TIMEDATE 

568  DISP  ’ SAVING  data  in  file  ";Filename$;"  on  ";Diskdrive$ 
570  Status  $ = "N" 

572  ASSIGN  ©Datapath  TO  FiIename$&Diskdrive$ 

574  OUTPUT  @Datapath;Status$ 

576  OUTPUT  @Datapath;Data_id$  140  chrs  description  of  data 

578  OUTPUT  @Datapath;Datacount  Inumber  of  xy  points 

580  OUTPUT  @Datapath;Filesize  Isize  of  array 

582  OUTPUT  ©Datapath;File( * ) 

584  ASSIGN  ©Datapath  TO  * 

586  OFF  ERROR 

§88  I 

590  Mistakeline:OFF  KEY 
592  LOOP 

594  EXIT  IF  TIMEDATE  Dtime >1.8 

596  END  LOOP 

598  DISP  CHR$(1 2) 

600  OUTPUT  2 USING  "#,K";"K" 

602  SUBEXIT 

604  ! 

606  I //////////////////////////////////////////////////////// 

608  I 

6 1 0 Cant_savedata:  ! 

612  BEEP  500, .6 

614  SELECT  ERRN 

616  CASE  72,73,76,78,81 ,82,90,93 

618  DISP  Diskdrive$;"  has  failed  or  is  not  available 

620  DISP  B ....CONTINUE  to  try  again." 

622  PAUSE 

624  Diskdrive$ 

626  CASE  84,85 

628  DISP  " This  disk  is  not  initialized 

630  DISP  " ....CONTINUE  to  try  again." 

632  PAUSE 

634  Diskdrive  $ = R" 

636  CASE  55,64 

638  DISP  " This  disk  is  full,  insert  new  floppy  and/or"; 

640  DISP  " select  new  drive  ...CONTINUE  " 

642  PAUSE 

644  Dsskdrive$  = "" 

646  CASE  ELSE 

648  CALL  Errortrap 

650  IF  LEN(Filename$)>0  THEN  GOTO  Send_to_disk 

652  END  SELECT 
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654  GOTO  Selectdrive 

656  ! 

658  SUBEND 
660  ! 

662  ! 

664  ! 

666  SUB  Errortrap 
668  Errortrap:  1 Original:  1 3 Nov  1 984 
670  I Revision:  06  Aug  1 987 

672  ! Trap  most  disk  errors  here 

674  COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

676  DIM  File$[20],Test$[160],What$[20],Ac$(5]  ‘ 

678  BEEP  400..6 

680  SELECT  ERRN 

682  CASE  54 

684  DISP  "DUPLICATE  FILE  NAME:  ";Filename$; 

686  DISP  "....PURGE  old  one?  (Y/N)"; 

688  UNPUT  What$ 

690  What$  « TRIM  $ (What$ ) 

692  SELECT  What$(1,1] 

694  CASE  "Y","y" 

696  PURGE  Filename$&Diskdrive$ 

698  CASE  ELSE 

700  Ac$  = ’VALID" 

702  CALL  Enterfilename(Ac$) 

704  END  SELECT 

706  CASE  52,53 

708  DISP  "Improper  FILE  NAME  — ENTER  NEW  FILE  NAME"; 

710  OUTPUT  2 USING  "#,K,K";"#";Filename$ 

712  LINPUT  Filename  $ 

714  Filename$  =TRIM$(Filename$) 

716  CASE  56 

718  DISP  "FILE:  ";Filename$;"  is  not  on  this  disk,  please  insert"; 

720  DISP  " correct  disk" 

722  PAUSE 

724  CASE  64 

726  DISP  "This  disk  is  full,  PLEASE  insert  clean  disk" 

728  PAUSE 

730  CASE  56 

732  DISP  "DATA  INPUT  disk  must  be  in  drivel!  "; 

734  DISP  "...CONTINUE  when  ready." 

736  PAUSE 

738  CASE  72,73,76 

740  DISP  Diskdrive $; 

742  DISP  " is  not  available,  type  correct"; 

744  DISP  " unit  specifier  (ie.  707,0')."; 

746  OUTPUT  2 USING  "K,r  ;Diskdrive$ 

748  LINPUT  Diskdrive$ 

750  CASE  80 

752  DISP  "CHECK  DISK  drive  doorl" 

754  PAUSE 

756  CASE  ELSE 

758  DISP  ERRM$;"  'CONTINUE'  when  fixed" 

760  PAUSE 

762  END  SELECT 

764  DISP  CHR$(1 2) 
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766  SUBEXIT 
768  SUBEND 
770  ! 

772  I * ************ 

774  l 

776  SUB  Menu_scroll(D$,T$,ltems$(*), INTEGER  !tem  cntfT o_se!ect,Choose( # ) ) 
778  Menu_scroll:l  Original:  22  Jun  1987,  Galen  Koepke,  NBS  723.04 
780  ! Revision:  06  Aug  1987,  10:00 

782  l 

784  ! A general  purpose  menu  utility  for  scrolling  items  and 

786  ! selecting  a given  number  of  them. 

788  I The  items  are  arranged  in  screens  of  15  items  each  and 

790  I the  user  may  access  screens  via  softkeys.  There  may  be 

792  I up  to  10  screens  or  150  items  to  choose  from. 

794  I ltems$(*)  contains  the  item  descriptions 

796  ! Item^cnt  is  the  number  of  items  in  ltems$(*) 

798  I Choosef* ) is  dimensioned  to  the  number  of  required  choices 

800  I and  will  be  filled  with  the  item  numbers  chosen. 

802  I To  select  is  the  number  of  required  choices. 

804  I 

806  OPTION  BASE  1 

808  PRINTER  IS  CRT 

810  DEG 

812  GOSUB  Defjvariables 

814  GOSUB  Define^screens 

8 1 6 GOSUB  Make_selections 

818  IF  Nuiljiie  THEN  ! reset  to  zero 

820  ltem_cnt  = 0 

822  ltems$(1 ) = "* 

824  To_select  = 0 I no  valid  selections 

826  END  IF 

828  SUBEXIT 

830  ! 

832  S //////////////////////////////////////////////////// 

834  ! 

836  Def_variables:l 

838  COM  /Interrupts/  INTEGER  Intr  prty 

840  COM  /Bugs/  INTEGER  Bugl  eBug2,Bug3, Printer 

842  COM  /Sys/  Sys_id$(10] 

844  I 

846  INTEGER  Screen_cnt,ltems_per_scn,FirstJtem(1 0),LastJtem(1 0) 

848  INTEGER  I, J,K,First_line,LastJine,Active_screen, Pointer,  Last_pt 

850  INTEGER  Local_prty,Skips,Knobcount,Pointeractive,KO,Null_file 

852  INTEGER  Exit_flag 

854  DIM  Marker$[8],Test$[1 60] 

856  I 

858  I initialize  parameters 

860  I 

862  Local  prty  - Intrprty 

864  IF  local_prty  < 1 THEN  Local _prty  = 1 0 

866  IF  LEN|Sysjd$)=0  THEN  Sysjd$  = SYSTEM $(" SYSTEM  ID") 

868  IF  Item^cnt  < 1 THEN 

870  Nulljile  = 1 

872  Item^cnt  - 1 

874  To^select-O 

876  ltems${1  ) = ”***  Empty 
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878  ELSE 

880  Null  file  =0 

882  END  IF” 

884  IF  To_select  > ltem_cnt  THEN  T o_select  = ltem_cnt 

886  Skips  = 0 

888  Knobcount=0 

890  Doneflag=0 

892  Marker$  = " = = = >"&RPT$(CHR$(8),4) 

894  RETURN 

896  I 

898  ! //////////////////////////////////////////////////// 

900  ! 

902  Define  screens:!  Set  up  screens  of  1 5 items  each. 

904  ” I 

906  ltems_per_scn  = 15  ! Maximum  number  of  displayable  items 

908  IF  INT(ltem_cnt/ltems_per_scn)  = ltem_cnt/ltems_per_scn  THEN 

910  Screen  cnt  = INT(ltem  cnt/ltems_per_scn) 

912  ELSE 

914  Screen  cnt  = INT(ltem_cnt/ltems_per  sen)  + 1 

916  END  IF 

918  J = 1 

920  FOR  I = 1 TO  Screen_cnt  ! set  up  each  screen 

922  Firstjtem(l)  = J 

924  IF  J + items_per_scn-1  <ltem_cnt  THEN 

926  Lastjtem(l)  = J + ltemsj)er_scn-1 

928  J = J + Items  per  sen 

930  ELSE 

932  Last  item(l)  = ltem_cnt 

934  END  IF” 

936  NEXT  I 

938  RETURN 

940  ! 

942  I /////////////////////////////////////////////////// 

944  ! 

946  Make_seiections:l  MENU  setup  and  use. 

948  Active_screen  = 1 ! first  screen  is  active 

950  Firstjine  = 2 ! first  printed  line  on  screen  = 2 or  greater. 

952  GOSUB  Write_screen  I activate  screen  at  Active_screen 

954  l and  set  Firstjine  and  Lastjine  for  Pointer 

956  ! write  Marker$  to  first  non-selected  line. 

958  KO  =0  ! Keys  start  at  zero 

960  Exit  flag  = 0 ! allow  ENTER  key  to  exit  when  selections  filled. 

962  IF  Sys  id$[1(41  = "S300"  THEN 

964  CONTROL  KBD,2;1 

966  STATUS  KBD,14;J 

968  IF  J = 0 THEN  I key  1 defined 

970  K0  = 1 

972  ELSE  I key  0 defined 

974  K0  = 0 

976  END  IF 

978  ELSE 

980  KO  =0 

982  END  IF 

984  Keyjoop:  I 

986  ON  KBD,Local_prty  GOSUB  Process_kbd 

988  ON  KNOB  .01  #Local_prty  GOSUB  Move_pointer 
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990  IF  Skips  <To_select  THEN 

992  DISP  D$  ' 

994  IF  To_select>1  THEN 

996  Test$  = " Select  "&VAL$(Skips+ 1 )&"  of  "&VAL$(To_select) 

998  ELSE 

1 000  Test$  - " Select" 

1002  END  IF 

1004  ON  KEY  KO  LABEL  Test$,Localj>rty  GOSUB  Select Jtem 

1006  ELSE 

1 008  IF  To  ^select  > 0 THEN 

1010  DISP  " Selection  process  complete  ..." 

1012  ELSE 

1014  DISP  " Menu  for  information  only  ...  " 

1016  END  IF 

1018  ON  KEY  KO  LABEL  "Accept" ,Local_prty  GOTO  Exitjine 

1020  END  IF 

1 022  IF  Aetive_screen < Screen_cnt  THEN 

1024  ON  KEY  K0  + 1 LABEL  ’ Next  Screen", Local_prty  GOSUB  Next_screen 

1026  ELSE 

1028  OFF  KEY  K0  + 1 

1 030  END  IF 

1032  IF  Active  screen  > 1 THEN 

1034  ON  KEY  K0  + 2 LABEL  B Last  Screen" „Loeal_prty  GOSUB  Last_screen 

1036  ELSE 

1038  OFF  KEY  KO  4*2 

1040  END  IF 

1042  IF  Skips  >0  THEN 

1044  ON  KEY  KO  + 3 LABEL  " Reset  Select" .Localjsrty  GOSUB  Selectjeset 

1046  ELSE 

1048  OFF  KEY  KO  + 3 

1050  END  IF 

1 052  IF  To  select  > 0 THEN 

1054  ON  KEY  K0  + 4 LABEL  " Abort  ".LocaljJrty  GOTO  Eseapejine 

1056  ELSE 

1058  OFF  KEY  KO  + 4 

1060  END  IF 

1062  IF  Exitjlag  THEN  Exitjine 

1064  GOTO  Keyjoop 

1066  Eseapejine: Skips  = 0 
1068  MAT  Choose  * (0) 

1070  To  select-0 

1072  Exit  !ine:OFF  KEY 
1074  OFF  KNOB 

1076  OFF  KBD 

1078  OUTPUT  KBD;CHR$(255)&CHR$(75); 

1080  PRINT  CHR$(1 28); 

1 082  I everything  cleared,  now  go  back  to  work. 

1084  RETURN 

1086  I 

1 088  I /////////////////////////////////////////////////// 

1090  \ 

1092  Next=screen:  ! 

1094  OFF  KBD 

1096  OFF  KNOB 

1098  OFF  KEY 

1100  IF  Active_screen  = Screen_cnt  THEN  RETURN 
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1102  Active_screen  = Active_screen  + 1 

1 1 04  GOSUB  Write  screen 

1106  RETURN 

1108  ! 

1110  ! /////////////////////////////////////////////////// 

1112  ! 

1114  Last  screen:  ! 

1116  OFF  KBD 

1118  OFF  KNOB 

1 1 20  OFF  KEY 

1122  IF  Active_screen  = 1 THEN  RETURN 

1124  Active_screen = Active_screen- 1 

1 1 26  GOSUB  Write_screen 

1 1 28  RETURN 

1130  ! 

1132  I ////////////////////////////////////////////////// 

1134  l 

1 1 36  Select  item:! 

1 1 38  OFF  KBD 

1140  OFF  KNOB 

1142  OFF  KEY 

1144  IF  NOT  Pointeractive  THEN 

1 146  DISP  "NO  additional  selections  for  this  screen." 

1148  BEEP 

1 1 50  WAIT  2 

1152  DISP  CHR$(1 2); 

1 1 54  RETURN 

1 1 56  END  IF 

1158  IF  Skips  = To  select  THEN 

1160  IF  To_select  = 0 THEN 

1 162  DISP  "This  menu  is  for  information  only,"; 

1164  DISP  " no  selection  allowed." 

1166  ELSE 

1 168  DISP  "All  selections  have  been  filled,"; 

1 170  DISP  " 'Select  Reset'  to  repeat." 

1172  END  IF 

1174  BEEP 

1176  WAIT  2 

1178  DISP  CHR$0  2); 

1 1 80  RETURN 

1 1 82  END  IF 

1 1 84  Skips  = Skips  + 1 

1186  Choose(Skips!  = First Jtem(Active_screen)  + Pointer-Firstjine 

1188  PRINT  CHR$(1 29);  ! inverse  video 

1 1 90  PRINT  TABXY(10,Pointer);ltems$(Choose(Skips)) 

1192  PRINT  CHR$(1 28); 

1 1 94  PRINT  TABXY(  1 pointer); 

1196  SELECT  Pointer 

1198  CASE  Firstjine 

1 200  GOSUB  Point_forward 

1202  CASE  Lastjine 

1204  GOSUB  Pointjaackward 

1 206  CASE  ELSE 

1 208  I move  forward  unless  it  requires  wrapping  to  beginning. 

1210  IF  Skips-1  >0  THEN  I check  for  selected  items. 

1212  I = Pointer-Firstjine 
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1214  LOOP 

1216  K = 0 

1218  FOR  J = 1 TO  Skips 

1 220  IF  First Jtem(Active_screen)  + 1 = Choose(J)  THEN  K = 1 

1 222  NEXT  J 

1224  EXIT  IF  K = 0 

1226  1=1+1 

1228  IF  I + First Jine  > Lastjine  THEN  K=°1 

1230  EXITIFK=-T 

1 232  END  LOOP 

1234  IF  K = 0 THEN 

1236  GOSUB  Point  forward 

1238  ELSE 

1240  GOSUB  Point_backward 

1 242  END  IF 

1 244  ELSE 

1246  GOSUB  Point  forward 

1 248  END  IF 

1250  END  SELECT 

1252  RETURN 

1254  ! 

1 256  ! ////////////////////////////////////////////////// 

1258  I 

1 260  Select  reset:  SClear  Choose  file 

1262  OFF  KBD 

1264  OFF  KNOB 

1266  OFF  KEY 

1268  Skips  = 0 

1270  MAT  Chooser  (01 

1272  GOSUB  Write_screen 

1274  RETURN 

1276  I 

1278  I ///////////////////////////////////////////////// 

1280  I 

1282  Processjcbd:!  Allow  use  of  arrows  and  enter  key  in  addition  to  soft. 
1284  Test$=KBD$ 

1286  IF  LEN(Test$)  = 1 AND  Test${1,1]<  >CHR$(32)  THEN 

1288  BEEP  80.,. 1 

1290  RETURN 

1292  END  IF 

1294  IF  Test$[1 ,1]=CHR$(32)  THEN  GOSUB  Point Jorward 

1296  IF  Test$(1f1|<>CHR$(255)  THEN  RETURN  r 

1298  SELECT  Test$[2,2] 

1300  CASE  CHR$(255) 

1 302  ! do  nothing 

1304  CASE  "V","T" 

1306  GOSUB  Point  forward 

1308  CASE  "Avw" 

1310  GOSUB  Point_backward 

1312  CASE  "E" 

1314  IF  Skips  < To jselect  THEN 

1316  GOSUB  Select Jtem 

1318  ELSE 

1320  i exit  routine 

1 322  Exit  Jlag  = 1 

1 324  END  IF 
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1326  CASE  ELSE 

1328  BEEP  80...  1 

1330  END  SELECT 

1332  Test$  = "" 

1 334  RETURN 

1336  ! 

1338  ! ////////////////////////////////////////////////// 

1340  ! 

1 342  Point_forward:Knobcount  = 5 
1344  GOSUB  Move  pointer 

1 346  RETURN 

1348  Point_backward:Knobcount=*-5 
1 350  GOSUB  Movejaointer 

1 352  RETURN 

1354  ! 

1356  ! ////////////////////////////////////////////////// 

1358  ! 

1 360  Jog  ^pointer:!  Move  the  selection  pointer  on  the  active  screen. 

1 362  ! without  regard  to  selected  values 

1364  IF  Knobcount>0  THEN  I Move  forward 

1 366  Pointer  = Pointer  + 1 

1 368  ELSE  I Move  backward 

1 370  Pointer  = Pointer- 1 

1372  END  IF 

1374  IF  Pointer < First Jine  THEN  Pointer  = Lastjine 

1376  IF  Pointer>Last  line  THEN  Pointer  = First Jine 

1378  RETURN 

1380  I 

1 382  I ///////////////////////////////////////////////////////// 

1384  I 

1 386  Move_pointer:l  Control  pointer  to  avoid  re-selection  of  items 
1 388  IF  NOT  Pointeractive  THEN  RETURN  I No  selections  to  be  made. 

1 390  Knobcount  = Knobcount  + KNOBX  + KNOBY 

1 392  IF  ABS(Knobcount)  < 4 THEN  RETURN 

1 394  Last_pt  = Pointer 

1 396  GOSUB  Jog  pointer 

1398  IF  Skips  >0  THEN 

1400  LOOP 

1 402  J - Pointer-Firstjine 

1 404  FOR  I - 1 TO  Skips 

1406  IF  First Jtem( Active  screen)  + J = Choose(l)  THEN  J = 999 

1408  NEXT! 

1410  IF  J = 999  AND  Pointer  = Last_pt  THEN  Pointeractive  = 0 

1412  EXIT  IF  Pointeractive  = 0 

1414  IF  J ~999  THEN  GOSUB  Jog^pointer 

1416  EXIT  IF  J<  >999 

1418  END  LOOP 

1420  END  IF 

1422  Knobcount  = 0 

1424  OUTPUT  KBD;CHR$(255)&CHR$(84);  ! Bring  screen  home 

1426  IF  Last_pt  = Lastjine  THEN  PRINT  CHR$(132); 

1428  PRINT" 

1430  IF  Pointeractive  THEN  ! Pointer  active 

1432  IF  Pointer  = Lastjine  THEN 

1434  PRINT  CHR$(1 32); 

1436  ELSE 
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1438  PRINT  CHR$d  28); 

1 440  END  IP 

1 442  PRINT  TABXYU  ,Pointer);Marker$;CHR$(1 28); 

1 444  END  IF 

1 446  RETURN 

1448  I 

1 450  I ////////////////////////////////////////////////// 

1452  ! 

1 454  Write_screen:l  Write  the  screen  pointed  to  by  Active  screen 
1456  I home  and  clear  screen 

1458  OUTPUT  KBD;CHR$(255)&CHR$(84)&CHR$(255)&CHR$(75); 

1460  Knobcount  = KNOBX  + KNOBY  I Clear  knob  and  keyboard 

1462  Knobcount -0 

1464  Test$  -KBD$ 

1466  Test$ 

1468  I 

1470  PRINT  TABXYd fFirst_line-1  );CHR$(1 32);"  Item  #j  Screen 

1472  PRINT  USING  "#f2053A,2Df3AT*Activej>creen,"  of  ";Sereen_cnt;B  | " 

1474  PRINT  T$;RPT$("  0,52-LEN(T$));CHR$d28); 

1476  J^O 

1478  REPEAT 

1480  IF  J = last Jtem( Active  screen)-First  item(Active_screen)  THEN 

1482  PRINT  CHR$(1 32);“ 

1484  PRINT  TABXYd  fFirstJine  + J);RPT$("  \80) 

1486  ELSE 

1488  PRINT  CHR${  128); 

1490  END  IF 

1 492  PRINT  TABXY(5 , First Jine  + J); 

1494  PRINT  USING  "3D,A##";FirstJtem(Active_screen)  + J,”  | " 

1496  IF  Skips  >0  THEN  I make  this  line  inverse  video 

1 498  FOR  1 = 1 TO  Skips 

1500  IF  First Jtem(Active_screen)+J  = Choose(l)  THEN 

1502  PRINT  CHR$d  29); 

1 504  END  IF 

1 506  NEXT  I 

1 508  END  IF 

1510  PRINT  TABXYd  OfFirstJine  + J);ltems$(FirstJtem(Active_screen)  + J) 

1512  J=J  + 1 

1514  UNTIL  J > = (LastJtem(Active_screen)-First  Jtem(Active_screen)  + 1 ) 
1516  Lastjine  = LastJtem(Active_screen)-FirstJtem(Active_screen) 

1518  Lastjine  = Lastjine  + Firstjine 

1520  ! 

1522  I set  marker  to  first  non-selected  item. 

1524  ! 

1 526  Pointeractive  = 0 

1528  IF  To__select>0  THEN  Pointeractive  - 1 

1530  IF  Skips>0  AND  Pointeractive  = 1 THEN  ! find  first  non-selected  item 

1532  J = Q 

1534  LOOP 

1536  Pointer  = Firstjine  + J 

1 538  FOR  8 = 1 TO  Skips 

1540  IF  First Jtem( Active  screen)  + J = Choose(l)  THEN  Pointer  = 0 

1 542  NEXT  I 

1544  EXIT  IF  Pointer <>0 

1546  J=J  + 1 

1 548  IF  Firstjine  + J > Lastjine  THEN 
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1 550  Pointeractive  = 0 

1552  Pointer  = First  line 

1554  END  IF 

1556  EXIT  IF  Pointer <>0 

1 558  END  LOOP 

1560  ELSE 

1562  Pointer  = First  line 

1564  END  IF 

1 566  IF  Pointeractive  THEN 

1568  IF  Pointer  = Last  line  THEN 

1570  PRINT  CHR$(1 32); 

1572  ELSE 

1574  PRINT  CHR$(1 28); 

1576  END  IF 

1 578  PRINT  TABXYd  ,Pointer);Marker$;CHR$(1 28); 

1580  END  IF 

1582  RETURN 

1584  SUBEND 
1586  I 

1588  I 

1590  ! 

1592  SUB  File_menu(Mask$,Ftype$,Fls$(#), INTEGER  Fls_cnt,Dir_on,Prt_on) 
1 594  File_menu:  ! 

1596  I Original:  29  Jun  1987,  G*  Koepke 

1598  ! Revision:  06  Aug  1987,  10:00 

1 600  OPTION  BASE  1 

1602  DEG 

1 604  COM  /Sys/  Sys_id$[1 0] 

1606  COM  /Files/  Diskdrive$l20],Filename$l14],Msj3ath$[500] 

1608  COM  /Interrupts/  INTEGER  Intr  prty 

1610  DIM  Directory $(1 50)[801,Bd$(150)[7 1 ] 

1612  DIM  D$[80],T$[52],lds${40],Stat$(11 

1614  INTEGER  Bd  cnt,File_cnt,l,C_cnt,C0(1 ), Format  error 

1616  IF  FIs  cnt>0  THEN  ALLOCATE  INTEGER  Choose(Fls_cnt) 

1618  I 

1 620  I Catalog  the  disk  specified 

1622  ! 

1624  ON  ERROR  GOTO  Cat_errors 

1626  DISP  " Reading  the  Directory  ...  " 

1 628  MASS  STORAGE  IS  Diskdrive$ 

1630  CAT  TO  Directory $(#);NO  HEADER, COUNT  File_cnt 

1632  OFF  ERROR 

1634  ! 

1 636  I set  up  array  of  legal  file  namel 

1638  ! 

1640  Bd  cnt  = 0 

1 642  FOR  I = 1 TO  File_cnt 

1644  IF  Directory  $ (l)[32,36]  =Ftype$  THEN  1 Ftype$  = "BDAT  B 

1646  I Ftype$  = "PROG  " 

1648  IF  LEN(Mask$)>0  THEN  ! Test  for  mask$ 

1650  IF  Directory $(l)[1,LEN(Mask$)]  = Mask$  THEN 

1652  Bd  _cnt  = Bd_cnt  + 1 

1 654  Bd$(Bd_cnt)  = Directory  $(l)[1  ;1 0) 

1656  END  IF 

1 658  ELSE 

1660  Bd  cnt  = Bd  cnt+1 
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1 662  Bd$(Bd_cnt)  = Directory  $(l)[1  ;1 0] 

1664  END  IF 

1666  END  IF 

1 668  NEXT  I 

1670  ! 

1672  ! set  up  file  menu 

1674  I 

1676  D$  = "Select  "&VAL$(Fls_cnt)&”  file  names  for  data  entry,” 

1678  T$  = "List  of  "&Ftype$&"files  on  "&Diskdrsve$ 

1 680  IF  LEN(Mask$) >0  THEN 

1682  t$s=T$&"  mask  = "&Mask$ 

1684  END  IF 

1686  IF  Bd  cnt>0  THEN 

1688  IF  Dir=on>0  THEN  GOSUB  Read_datajd 

1690  IF  Prt”on  THEN 

1 692  GOSUB  ListjJirectory 

1694  ELSE 

1 696  C=cnt  = Fls_cnt 

1698  DISP  CHR${1 2) 

1700  IF  Fls_cnt>0  THEN 

1702  CALL  Menu  scroll{D$,T$tBd$r),Bd  cnt.C  cnt,Choose(#)) 

1 704  ELSE 

1706  CALL  Menu_scroll  (D  $ f T $ ( Bd  $ r ) » Bd_cnt,  G_entf  CO  ( # ) ) 

1708  END  IF 

1710  I 

1712  I transfer  file  names  to  Fls$(*). 

1714  I 

1716  IF  C_cnt  = 0 THEN  ! selection  process  aborted 

1718  MAT  Fls$  = ("") 

1720  ELSE 

1 722  MAT  SORT  Chooser) 

1724  FOR  1 = 1 TO  C=cnt 

1 726  Fis$(l)  = Bd$(Choose(l))(1  ;1 0] 

1728  NEXT  I 

1730  END  IF 

1732  END  IF 

1734  ELSE 

1736  DISP  " This  directory  contains  no  BOAT  files  ...  " 

1738  WAIT  2.5 

1740  END  SF 

1742  DISP  CHR$(1 2) 

1744  SUBEXIT 

1746  Cat_errors:l 

1748  DISP  "ERROR  ...  ";ERRM$ 

1750  BEEP 

1752  PAUSE 

1754  Cent  -=  0 

1756  MAT  Fls$  = ("") 

1758  SUBEXIT 

1760  ! 

1 762  ! //////////////////////////////////////////////////// 

1764  ! 

1766  Read_datajd:  ! This  routine  expects  to  see  lds$  from 
1768  T GRAPHED  AT A raw  data  files. 

1770  DISP  " Reading  file  contents  ...  " 

1 772  FOR  I = 1 TO  Bd  ent  I each  BOAT  file 
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1774  lds$  = "Data  not  recognized." 

1776  ON  ERROR  GOTO  Not_recognized 

1 778  ASSIGN  @lo_path  TO  Bd$(l)[1  ;1 0] 

1780  ENTER  @lo_path;Stat$ 

1782  SELECT  Stat$ 

1784  CASE  "N" 

1786  ENTER  @lo_path;lds$ 

1788  CASE  "Y" 

1790  lds$  = "Complete  graph  ...  use  GRAPH_DATA." 

1792  END  SELECT 

1794  Not  recognized:ASSIGN  @lo_path  TO  * 

1796  ” OFF  ERROR 

1798  IF  Dir_on  = 2 THEN 

1 800  GOSUB  lnterpret_1 

1 802  IF  Format  error  THEN  GOTO  Other_format 

1 804  GOTO  Go”  on 

1 806  END  IF 

1 808  Other  format:! 

1810  ” Bd$(l)[11,71]  = " ...  "&lds$ 

1812  Go_on:NEXT  I 
1814  RETURN 

1816  ! 

1818  ! /////////////////////////////////////////////////// 

1820  ! 

1822  Interpret^ :!  This  is  used  to  interpret  TEM  program  ID  strings. 

1 824  Format_error  = 0 

1826  I identify  this  particular  format 

1828  IF  LEN(lds$)<40  THEN 

1830  Format  error  = 1 

1832  RETURN 

1834  END  IF 

1836  IF  lds$[40]<>"*"  THEN 

1838  Format_error  = 1 

1 840  RETURN 

1 842  END  IF 

1 844  I make  the  information  readable 

1846  Bd$(l)[1 1,15]  = " ...  " 

1848  Bd$(l)[16,25]  = lds$[1,10] 

1 850  Bd$(l)[26,32]  = \ "&lds$[1 1 ,1 2]&":"&lds$[1 3,14] 

1852  Bd$(l)[33,42]  = ",  "&lds$[1 5,1 6]&"  "&lds$[1 7,1 8]&"  "&lds$[1 9,20] 

1854  Bd$(l)[43,55]  = ",  "&lds$[21 ,27]&"  MHz" 

1856  Bd$(l)[56,65]  = ",  "&lds$[28,33]&"vm" 

1858  Bd$(l)[66,71]  = ","&lds$[38,39] 

1 860  RETURN 

1862  I 

1 864  I /////////////////////////////////////////////////// 

1866  I 

1 868  List_directory:  1 This  routine  will  provide  a tabular  listing  of 
1 870  I the  directory  along  with  lds$  if  provided 

1872  I 

1874  DISP  " Listing  directory  ...  " 

1876  PRINTER  IS  PRT 

1878  PRINT  USING  "//" 

1 880  PRINT  T$ 

1882  PRINT  RPT$("-", 80) 

1884  PRINT  "Filename"; 
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1 886  SF  Dir_on  THEN 

1 888  PRINT  " ...  contents" 

1 890  ELSE 

1 892  PRINT 

1894  END  IF 

1896  PRINT  RPT$("~",80) 

1 898  FOR  1-1  TO  Bd_cnt 

1900  PRINT  Bd$(l) 

1 902  NEXT  I 

1904  PRINT  RPT$("  ",80) 

1 906  PRINT 

1 908  PRINTER  IS  CRT 

1910  RETURN 

1912  SUBEND 
1914  I 

1916  ! *** ***** 

1918  S 

1920  SUB  Load_disk_data(Basket_f  ile] * UNTEGER  Basketsize,Data_id$, INTEGER  Fig) 

1 922  Load__disk_data:  ! Original:  1 3 Nov  1 984 

1924  ! Revision:  02  Dec  1987 

1 926  IThis  routine  will  enter  data  files  from  the  disk 

1 928  OPTION  BASE  1 

1930  I 

1932  COM  /Sys/  Sysjd$ 

1934  COM  /History/  Status$nLTime_orgn$[8I,Date_orgn$[1 11 

1936  COM  /History/  Time_chng$[8hOate_chng${1 1],Description$[1 60] 

1938  I 

1940  COM  /Labels/  Labels$(30)[60], INTEGER  Lbl_count,REAL  Lbl_addr(30,6) 
1942  ILbl^addr:  x,  y,  pen,  size,  LDIR,  LORG 
1 944  ! 

1946  COM  /Data_param/  INTEGER  Datacount,Filesize»Curvecount,Roster(1 7,4) 

1948  COM  /Data_param/  REAL  Syrn_size„Symbol$(1  7)(2],Curve_id$(1 7)[40] 

1950  COM  /Dataparam/  REAL  Xmin_data,Xmax_data 

1952  COM  /Data^param/  REAL  Ymin_data,Ymax_data 

1954  ! 

1956  IRoster:  Curve#.  Start  Addr  in  File]*),  Datacount,  and  PEN 
1958  !Symbol${i)  = or  "Y"  = > no  symbol,  connect  pts 
1960  !Symbol$(i)  ~"*Y"  = > * symbol,  connect  pts 
1962  !Symbol$(i)  = "*N"  - > * symbol,  do  not  connect  pts 
1964  ! 

1966  COM  /Background/  Graphtype$(12],Margins$(2)[10],Papersize$l1] 

1 968  COM  /Background/  REAL  Pen_speed,  INTEGER  Backgnd__pen,Auto_time 

1 970  COM  /Background/  INTEGER  Auto_file,REAL  X_crossJy,Y_cross_x 

1972  COM  /Background/  Xgrid_tick$(4], INTEGER  Xmajor.Xminor 

1974  COM  /Background/  Ygrid_tick$[4],INTEGER  Ymajor,Yminor 

1976  COM  /Background/  REAL  Xmin_graph,Xmax_graph,Ymin_graph,Ymax_graph 

1978  I 

1980  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

1982  COM  /Interrupts/  INTEGER  Intr^prty 

• 1 984  COM  /Enlarge Jile/  INTEGER  Overflow 

1986  COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500S 

1 988  COM  /Data  stuff/  INTEGER  Number, REAL  Delta jc 

1990  I 

1 992  INTEGER  R,Hold_size,Local_prty .Allocated, Fls_cnt 

1994  DIM  Ac$l5],Tempfile$nO],Mask$[10],Ftype$[5],Fls$(1)[14] 

1996  REAL  Dtime 
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1998  OFF  KEY 

2000  Local_prty  = lntr_prty 

2002  ! 

2004  (Select  the  disk  drive  where  the  data  exists 
2006  I 

2008  IF  Overflow <>0  THEN  Overflow  = 0 
2010  Hold_size  = 0 

2012  Dtime  = 0= 

2014  Allocated =0 

2016  Selectdrive:  I 

201 8 IF  Diskdrive  $ = "NO  DISK"  THEN  Diskdrive$  = "" 

2020  IF  LEN (Diskdrive $ ) > 0 THEN  GOTO  Choosefilename 

2022  GRAPHICS  OFF 

2024  OUTPUT  2 USING  "#fK";"K" 

2026  CALL  Select  disk 

2028  IF  Diskdrive $ = "NO  DISK’  THEN  GOTO  Mistakelineset 

2030  Choosefilename:  I 

2032  Tempfiie$  = Filename$ 

2034  IF  LEN(Filename$)>0  THEN  GOTO  Bring  in_data 

2036  Ac$  = "CAT- 

2038  CALL  Enterfilename(Ac$) 

2040  IF  LEN(Filename$)  = 0 OR  POS(Filename$,"#")>  1 THEN 
2042  IF  POS(Filename$,"*")>  1 THEN  I set  mask$ 

2044  Mask$  = Filename$[1  ,POS(Filename$," * "H  ] 

2046  Filename$  = "" 

2048  ELSE 

2050  Mask$  = ""l  no  preselection 

2052  END  IF 

2054  Ftype$  = "BDAT  " I examine  BDAT  files  only 

2056  Fls_cnt=1  I select  one  file 

2058  lntr_prty  = Local_prty  + 1 

2060  CALL  File_menu(Mask$,Ftype$,Fls$(#)lFls_cnt,0,0) 

2062  lntr_prty  = Local_prty 

2064  Filename$  =Fls$(1 ) 

2066  IF  LEN(Filename$)  =0  THEN  1 aborted 

2068  Filename$  =Tempfiie$ 

2070  GOTO  Mistakelineset 

2072  END  IF 

2074  END  IF 

2076  Bring Jnjjata:  I 

2078  I 

2080  IFind  this  file  on  the  disk- 

2082  I 

2084  ON  ERROR  GOTO  Cantjindfile 

2086  ASSIGN  ©Datapath  TO  Filename$&Diskdrive$ 

2088  OFF  ERROR 

2090  Dtime = TIMED  ATE 

2092  DISP  " LOADING  disk  file:  ";Filename$;"  ...  "; 

2094  ON  ERROR  GOTO  Badjile 

2096  ENTER  @Datapath;Status$ 

2098  OFF  ERROR 

2100  ON  ERROR  GOTO  Cantjindfile 

2102  SELECT  Status  $ 

2104  CASE  "Y"  I All  graphics/data  parameters  exist.REN  100,2 
2106  DISP  " Complete  graph.  " 

2108  ENTER  @Datapath;Time_orgn$,Date_orgn$ 
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2110 

2112 

2114 

2116 

2118 

2120 

2122 

2124 

2126 

2128 

2130 

2132 

2134 

2136 

2138 

2140 

2142 

2144 

2146 

2148 

2150 

2152 

2154 

2156 

2158 

2160 

2162 

2164 

2166 

2168 

2170 

2172 

2174 

2176 

2178 

2180 

2182 

2184 

2186 

2188 

2190 

2192 

2194 

2196 

2198 

2200 

2202 

2204 

2206 

2208 

2210 

2212 

2214 

2216 

2218 

2220 


ENTER  @Datapath;Time_chng  $ ,Date_chng  $ 

ENTER  @Datapath;Description$ 

ENTER  @Datapath;Labels$ ( * ),Lbl_count,Lbl_addr( * ) 
ENTER  @Datapath;Curve  jd  $ ( * ),  Symbol  $ ( * ) 

ENTER  @Datapath;Roster(*),Curvecount 
ENTER  @Datapath;Graphtype$,Margins$(*) 

ENTER  @Datapath;X_cross_y,Y_cross_x 
ENTER  @Datapath;Xgrid_tick$,Xmajor,Xminor 
ENTER  @Datapath;Ygrid=tick$,Ymajor,Yminor 
ENTER  @Datapath;Xmin_graph,Xmaxjjraph 
ENTER  @Datapath;Ymin_graphfYmax_graph 
CASE  "N"  S Only  data  parameters  exist. 

DISP  " RAW  data.  " 

CASE  ELSE 

Badjile:  DISP  CHR$(12) 

DISP  "Data  file  is  not  recognized,  entry  aborted."; 

DISP  " ...continue." 

BEEP 
PAUSE 
OFF  ERROR 
GOTO  Mistakelinesef 
END  SELECT 
S 

ENTER  @Datapath;Data  id$ 

IF  Fig  THEN 

ENTER  @Datapath;Delta_x 
ENTER  @Datapath;Datacount 
Hold  size  = Datacount 
ELSE 

ENTER  @Datapath;Datacount 
ENTER  @Datapath;Hold_size 
END  IF 

IF  NOT  Allocated  THEN 

IF  Datacount  > =1  AND  Hold_size>  =1  THEN 
ALLOCATE  Holding_file(Hold_size,2) 

ELSE 

ALLOCATE  Holding_file(1 ,2) 

END  IF 
Allocated  = 1 
END  IF 

ENTER  @Datapath;Holding_file(#) 

ASSIGN  ^Datapath  TO  * " 

OFF  ERROR 

IF  NOT  Fig  THEN  Delta_x  * Holding  Jile(2,1  )-HoldingJile(1 ,1 ) 
IF  Datacount  = 0 THEN  Mistakeline 
! 

ICopy  data  from  Holding  file(#)  to  Basket_file(*) 

! 

MAT  Basketjile  - CO.) 

IF  Datacount  > Basketsize  THEN  IReceiving  file  too  small. 
Allocated  = 0 

DEALLOCATE  Holding Jile(*) 

DISP  " DATA  FILE  overflow,  new  data  discarded.  K; 

DISP  " (continue)  " 

BEEP 

PAUSE 
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2222  IF  Status  $ = "Y"  THEN 

2224  Curvecount  = 0 

2226  MAT  Roster  = (0) 

2228  END  IF 

2230  Overflow  = Hold_size 

2232  GOTO  Mistakelineset 

2234  END  IF 

2236  Copydatafile:  ! 

2238  FOR  R = 1 TO  Datacount 

2240  Basket  file(R,1)  = Holding_file(R,1) 

2242  Basket~file(R,2)  = Holding~file(R,  2) 

2244  NEXT  R 

2246  Basketsize  = Datacount 

2248  GOTO  Mistakeiine 

2250  I 

2252  Mistakelineset:Datacount  = 0 
2254  Misfakeline:OFF  KEY 

2256  IF  Allocated  THEN  DEALLOCATE  Holding_file<#) 

2258  LOOP 

2260  EXIT  IF  TIMEDATE-Dtime >1.8 

2262  END  LOOP 

2264  DISP  CHR${1 2) 

2266  OUTPUT  2 USING  "#,K";"K" 

2268  SUBEXIT 

2270  I 

2272  I //////////////////////////////////////////////////////// 

2274  1 

2276  Cant  findfile:  lError  in  searching  for  the  file. 

2278  BEEP  500, .6 

2280  SELECT  ERRN 

2282  CASE  56 

2284  DISP  "That  file  does  not  exist  on  this  disk 

2286  CASE  72,73,76,82 

2288  DISP  Diskdrive$;”  has  failed  or  is  not  available 

2290  CASE  ELSE 

2292  DISP  ERRM$; 

2294  END  SELECT 

2296  DISP  " ....CONTINUE  to  try  again." 

2298  PAUSE 

2300  Filename$  = 

2302  Diskdrive$ ' 

2304  GOTrO  Selectdrive 

2306  ! 

2308  SUBEND 
2310  ! 

2312  ! 

2314  ! 

2316  SUB  Data_check(Test$) 

2318  IThe  following  checks  for  a lower  case  "e"  in  an  input  number  and, 
2320  !if  it  exists,  converts  it  to  a number  with  an  upper  case  "E".  The 
2322  Icomputer  will  recognize  only  upper  case  input  otherwise. 

2324  INTEGER  Temp 

2326  IF  POS(Test$,"e")  THEN 

2328  Temp  = POS(Test$,"e") 

2330  Test$[Temp]  = "E"&Test$[Temp  + 1 ,LEN(Test$)J 

2332  END  IF 


B191 


2334  lend  of  conversion. 

2336  SUBEXIT 

2338  SUBEND 

2340  SUB  Select_disk 

2342  Selectjjisk:  ! Original:  1 3 Nov  1 984 

2344  ! Revision:  02  Dec  1 987 

2346  OPTION  BASE  1 

2348  COM  /Files/  Diskdrive$[20],Filename$n4]sMsj3ath$(50Q] 

2350  COM  /Interrupts/  INTEGER  Intr  prty 

2352  COM  /Sys  rrtsi/  Msijd$ 

2354  COM  /Sys  / Sys  id  $ 

2356  INTEGER  local  j)rtysDdePtcChoose(1 ) 

2358  DIM  Disc$(30H60],Title$[40],Displ${60] 

2360  Localjsrty  = Intr  prty 

2362  OFF  KEY 

2364  I 

2366  ! Define  the  disk  drives  available  for  this  system,,  reserve  the 

2368  S first  characters  for  the  drive  address  and  the  characters  after 

2370  ! the  - for  a description  of  the  drive. 

2372  I 

2374  ! Example: 

2376  ! Disc$(1)^":,700,0,0  HP  S133H  HARD  disk,  volume  0/ 

2378  I 

2380  \ 

2382  Displ$  = " SELECT  DISK  DRIVE  ...  Abort  will  cancel.  B 
2384  Title  $ = " Available  disk  drives  for  this  system.  " 

2386  Pt-1  ! allow  only  one  select 

2388  I 

2390  IF  Diskdrive$(1,1]<  THEN  Diskdrive  $ * — 

2392  IF  Msijd$[1J]<  THEN  Msijd$  = SYSTEM $(" MSI") 

2394  IF  MsiJd$[1J]<  >":"  THEN  ! Must  be  HFS  subdirectory 

2396  Ms_path$  = Msiid$[1 ,POS(MsiJd$,":")-1|  ! strip  off  subdirs 

2398  IF  Ms_path$[LEN(Ms=path$);1]  < >"/"  THEN  Ms_path$  =Ms_path$&"/H 

2400  Msi  id  $ = Msi  id  $ [POS(Msi  id  $ , " : " ),LEN  (Msi  id  $ )1 

2402  END  IF 

2404  Diskdrive$  =TRIM$(Diskdrive$) 

2406  Msi  Jd  $ « ' TRIM  $ (Msi  Jd  $ ) 

2408  IF  LEN(Diskdrive $ ) > 0 AND  LEN(Msi  jd$)>0  THEN 
2410  Disc$(1 ) - Diskdrive $&RPT$("  \17-LEN(Diskdrive$)) 

2412  Disc$(1 ) -Disc$(1  )&"-  Last  selected  diskdrive.” 

2414  Dd  = 1 1 1 

,2416  „ IF  Diskdrive$<  >MsiJd$  THEN 
2418  Disc$(2)  = MsiJd$&RPT$r  M7-LEN(Msi_id$)) 

2420  Disc$(2)  = Disc$(2)&"-  Start-up  mass  storage  unit  specifier." 

2422  Dd  = Dd  + 1 

2424  ELSE 

2426  Disc$(1 ) = Disc$(1  )&"  Start-up  MSUS.” 

2428  END  IF 

2430  ELSE 

2432  IF  LEN(MsiJd$)>0  THEN 

2434  Disc$(1 ) -MsiJd$&RPT$(”  \1 7-LEN(MsiJd$)| 

2436  Disc$(1 ) = Disc$(1  )&"-  Start-up  mass  storage  unit  specifier.” 

2438  Dd  = 1 

2440  ELSE 

2442  Dd  - 0 

2444  END  IF 
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2446 

2448 

2450 

2452 

2454 

2456 

2458 

2460 

2462 

2464 

2466 

2468 

2470 

2472 

2474 

2476 

2478 

2480 

2482 

2484 

2486 

2488 

2490 

2492 

2494 

2496 

2498 

2500 

2502 

2504 

2506 

2508 

2510 

2512 

2514 

2516 

2518 

2520 

2522 

2524 

2526 

2528 


END  IF 


Disk: 


! customize  system  drives  here 

! Follow  format  with  - after  unit  specifier,  description  is 
! optional  but  recommended. 


Disc$(Dd  + 1 ) = 702,0 

Disc$(Dd  + 2)  = ":, 702,1 
Disc$(Dd  + 3)  = ":, 703,0 
Disc  $ (Dd  + 4)  = " : , 1 400 


- HP  9122  dual  microfloppy  left  drive" 

- HP  9122  dual  microfloppy  right  drive' 

- HP  9125  single  5.25  floppy  drive" 

- HP  91 33H  hard  disk  volume  1 " 


Dd  = Dd  + 4 I add  the  number  of  drive  specifiers  above 


IF  Sys  id$[1,41<  >"S300' 
Disc$(Dd  + 1)  = ":,4,1 
Dise$(Dd  + 2)  = ":,4,0 
Dd  = Dd  + 2 
END  IF 


THEN 


LEFT  internal  series  200" 
RIGHT  internal  series  200" 


CALL  Menu  scroll(Displ$,Title$,Disc$(#),Dd,Pt,Choose(*)) 

IF  Pt  = 0 THEN 

Diskdrive$  = "NO  DISK" 

ELSE 

Dd  = POS(Disc$(Choose(Pt)},"-")-1  ! find  - 
IF  Dd>5  THEN  I valid  msus 

Diskdrive  $ = TRIM  $ (Disc  $(Choose(Pt)}[1  ,Dd]) 

ELSE 

DISP  " ERROR  in  reading  MSUS  from  string,  - chr  not  found. 
BEEP 

CALL  Pause  key_on 
Diskdrive  $ =”"NO  DISK" 

END  IF 
END  IF 

Diskselected:OFF  KEY 
SUBEXIT 
SUBEND 
I 

! * ****** 

! 

SUB  Enterfilename(Ac$) 


2530  Enterfilename:  ! Original:  1 3 Nov  1 984 

2532  I Revision:  10  Dec  1990  includes  HFS  directories 

2534  OPTION  BASE  1 

2536  COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

2538  COM  /Interrupts/  INTEGER  lntr_prty 

2540  INTEGER  l,Ascii_num,Maskflag,Namelength 

2542  DIM  Test$[256]7Hfs_temp$[161] 

2544  Namelength  = 10 

2546  IF  LEN (Ms_path $ ) > 0 THEN  OUTPUT  KBD  USING  "K,#";"#"&Ms_path$&"H" 
2548  DISP  " ENTER  HFS  directory  PATH  (no  file)"; 

2550  IF  Ac$  < > "PATH"  THEN 

2552  DISP  ",  ENTER  / for  HFS  ROOT  or  null  for  LIF..."; 

2554  END  IF 

2556  LINPUT  Hfs  temp$ 


B193 


2558 

2560 

2562 

2564 

2566 

2568 

2570 

2572 

2574 

2576 

2578 

2580 

2582 

2584 

2586 

2588 

2590 

2592 

2594 

2596 

2598 

2600 

2602 

2604 

2606 

2608 

2610 

2612 

2614 

2616 

2618 

2620 

2622 

2624 

2626 

2628 

2630 

2632 

2634 

2636 

2638 

2640 

2642 

2644 

2646 

2648 

2650 

2652 

2654 

2656 

2658 

2660 

2662 

2664 

2666 

2668 


Hfs  temp$  =TRIM$(Hfs_temp$) 

IF  LEN(Hfs_temp$)>0  THEN 

IF  LEN(Hfs_temp$)>  1 AND  Hfs_temp$[LEN(Hfs_temp$);11<  >"/"  THEN 
Hfs  temp$  = Hfs_temp$&"/" 

END  IF 

IF  LEN(Hfs  temp$)  = 1 THEN  Hfsjemp$  = 

Namelength  = 1 4 
END  IF 

IF  Ac$  * "PATH"  THEN 
Ms_path$  = Hfs_temp$ 

SUBEXIT 
END  IF 

IF  LEN(Filename$) >0  THEN  OUTPUT  KBD  USING  "K,#";"#"&Filename$&"H 
Efn:  ! 

DISP  ■ ENTER  the  FILE  NAME  ... 

SELECT  Ac$ 

CASE  "CAT" 

DISP  "(ENTER  CAT  mask*  or  ENTER  null  to  CAT}"; 

CASE "ABORT" 

DISP  "(ENTER  null  to  ABORT) 

CASE  "VALID" 

DISP  "(must  be  a VALID  name!)  "; 

END  SELECT 
UNPUT  Test$ 

Test$  = TRIM$(Test$) 

IF  LEN(Test$)  =0  AND  Ac$  = "VALID"  THEN  GOTO  Enterfilename 
IF  LEN(Test$)=0  THEN  Abortline 
IF  LEN(Test$)>  Namelength  THEN 
BEEP 

DISP  "ERROR  in  NAME  ENTRY  - max  ";Namelength;"  chars,  you  have  "; 
DISP  LEN(Test$);"  " 

WAIT  1 .8 

OUTPUT  2 USING  "K,#";"#"&Test$&"H" 

GOTO  Efn 
END  IF 

IF  POS(Test$,"*")>  1 THEN 

Test$  -Test$(1  ,POS(Test$,"*B)-1] 

Maskf  lag  - 1 
ELSE 

Maskflag  = 0 
END  IF 

FOR  1 = 1 TO  LEN(Test$) 

Ascii_num  = NUM(Test$Ul) 

SELECT  Ascii_num 

CASE  65  TO  90,95,97  TO  122,48  TO  57 
(Allowed  characters 
CASE  ELSE 
BEEP 

DISP  "ERROR  in  NAME  ENTRY-ILLEGAL  CHARACTERS,  TRY  AGAIN. 
WAIT  1.8 

OUTPUT  2 USING  "K,#";"#" &Test$&"H" 

GOTO  Efn 
END  SELECT 
NEXT  I 

IF  Maskflag  THEN 

Filename$  -Test$&"*B 
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2670  ELSE 

2672  Filename$  =Test$ 

2674  END  IF 

2676  Ms_path$  =Hfs_temp$ 

2678  SUBEXIT 

2680  Abortline:Filename$  = "" 

2682  IF  Ac$  = "CAT"  THEN  Ms_path$  = Hfs  temp$ 

2684  SUBEXIT 

2686  SUBEND 
2688  I 

2690  I 

2692  I 
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B.6  GD  HISTOGRM 


100!  RE-STORE  "GD_HISTOGRM:,1400“ 

102  ! 

104  SUB  User  sub(REAL  Wave(#), INTEGER  D volume, D count) 

106  ! 

108  Histogram  oniy:! 

110  OPTION  BASE  1 

112  RAD 

1 14  REAL  Vmin, Vmax, VJast, Volt  zfVolt_1 00,V_first,Vptp 

116  REAL  Histogram!!  6384,21 

118  INTEGER  No_p_bins,His_zeroJev 

120  INTEGER  His_100Jev,Maxpoint 

1 22  REAL  Delta  v,Delta_v_prc,Ov, Undr 

124  ! 

1 26  Dateline:  ! 

128  I——— — — 

1 30  I This  program  written  by  S.M.  Chesnut 

132  ! March  7,  1991 

1 34  I Last  revision: 

136  f«— 

1 38  INTEGER  lndxfMin_bin,Half  j3in,LLeveLZipo,Hundred»DonefAuto,Pnts 

140  DIM  Ch$|1],X_units$(1 5LY_units$[151 

142  ALLOCATE  History (16384) 

1 44  Pnts  ~ D count 

146  INPUT  “What  are  the  units  of  the  x axis?'\X_units$ 

148  INPUT  "What  are  the  units  of  the  y axis?"fY_units$ 

1 50  GOSUB  Mak_histogram 

1 52  REDIM  Histogram(Noj3j3insf2),Wave(No_pjDins,2) 

1 54  MAT  Wave  = Histogram 

156  D count  = No_o_bins 

1 58  dIaLLOCATE  Hist_ary(* ) 

1 60  SUBEXIT 

1 62  Makhistogram:  ! 

164  S 

166  DISP  “Calculating  the  histogram,  please  wait.” 

168  Auto~1 

170  Done-0 

172  Level  = 0 

174  Ch$ - “n" 

176  GOSUB  Vmax  min  ptp 

178  No  o,  bins  =1024  ’ 

180  Minbin  = Pnts  DIV  100 

1 82  WHiE  (Ch$  = "n")  OR  (Ch$  = aN” ) 

1 84  WHILE  NOT  Done 

1 86  Delta  _v  = Vptp/No_o_bins 

188  Half_bin  = Noobins  DIV  2 

1 90  MAT  Hist  ary  = (0) 

1 92  FOR  1-1  TO  Pnts 

1 94  Level  = 1 + INT((Wave(l,2)-Vmin)/Deltajv) 

196  IF  Level  >No_p_bins  THEN 

1 98  Level  = No  _o_bins 

200  END  IF 

202  Hist_ary  (Level)  = Hist_ary(Level)  + 1 

204  NEXT  I 

206  Bugl  =0 

208  IF  Bugl  THEN 
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210 

PRINTER  IS  PRT 

212 

FOR  1 = 1 TO  No_o_bins 

214 

PRINT  Hist  ary(l) 

216 

NEXT  1 

218 

PRINTER  IS  CRT 

220 

END  IF 

222 

Bugl  =0 

224 

His  zero  lev  = 0 

226 

HisJ00jev=0 

228 

Zipo  = 0 

230 

Hundred =0 

232 

FOR  1 = 1 TO  Half_bin 

234 

IF  Hist_ary(l)  > His_zeroJev  THEN 

236 

His_zero_lev  = Hist_ary(l) 

238 

Zipo  = 1 

240 

END  IF 

242 

NEXT  1 

244 

1 » Half  bin 

246 

WHILEl<No  o bins 

248 

IF  Hist_ary(l  + 1 ) > His J OOJev  THEN 

250 

His_1  OOJev  = Hist_ary  (1  + 1 ) 

252 

Hundred  = 1 + 1 

254 

END  IF 

256 

1 = 1 + 1 

258 

END  WHILE 

260 

IF  Auto  THEN 

262 

IF  (His_zeroJev  < Min_bin)  THEN 

264 

No  o bins  = No  o bins  DIV  2 

266 

IF  No_oJ)ins<  128  THEN 

268 

GOSUB  Hist_message 

270 

Done  = 1 

272 

END  IF 

274 

ELSE 

276 

Done  = 1 

278 

END  IF 

280 

ELSE 

282 

Done  = 1 

284 

END  IF 

286 

END  WHILE 

288 

GOSUB  Calc_v_prms 

290 

GOSUB  Hist  query 

292 

END  WHILE 

294 

GOSUB  Xy  histogram 

296 

RETURN 

298  Hist 

message:  1 

300 

PRINT  "The  number  of  bins  in  the  histogram  is  less  than  128/ 

302 

PRINT  "Therefore,  the  voltage  resolution  is  quite  bad  and  you" 

304 

PRINT  "may  find  it  is  unacceptable.  Keep  this  in  mind  when  you 

306 

PRINT  "are  asked  if  the  histogram  is  an  acceptable  one." 

308 

WAIT  2.0 

310 

RETURN 

312  ! 

314  Calc 

_v_prms:  ! 

316 

Volt_z  - Vmin  + Zipo  * Delta_v-Delta_v/2. 

318 

Volt_1 00  = Vmin  + Hundred  * Delta_v-Delta_v/2. 

320 

V_first  = Wave(1,2) 

322 

VJast  = Wave(Pnts,2) 

324 

Delta_v_prc  = Delta_v  # 1 00/Vptp 
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RETURN 


326 
328  ! 

330  Hist_query:  ! 

332  ! 

334  CLEAR  SCREEN 

336  PRINT  "The  first  waveform  point  - ";\Mirst;"  ';Y  _units$;",B 
338  PRINT 

340  PRINT  " The  last  waveform  point  = ";VJast;"  ";Y_units$;’\" 

342  PRINT 

344  PRINT  "The  minimum  = ";Vmin;"  ";Y_units$;V 

346  PRINT 

348  PRINT  "The  maximum  = ";Vmax;"  ";Y_units$;"." 

350  PRINT 

352  PRINT  "There  were  ";No=o_bins;"bins  used  in  the  histogram." 

354  PRINT 

356  PRINT  "Each  histogram  bin  is  equivalent  to";Delta  v;"  ";Y  units$;V 
358  PRINT 

360  PRINT  "or";Delta  v_prc;"%  of  the  waveform  peak-to-peak." 

362  PRINT 

364  PRINT  "The  0%  level  occurs  at";Voit  z;"  ";Y_units$;"  with";His_zeroJev;"occurrences." 

366  PRINT 

368  PRINT  "The  100%  level  occurs  at";Volt_100J  ";Y_units$;"  with"  ;His_100Jev;*  occurrences.” 
370  INPUT  "Is  this  an  acceptable  histogram?",Ch$ 

372  IF  (Ch$  = "n")  OR  (Ch$  = "N")  THEN 

374  INPUT  "How  many  histogram  bins  would  you  like  to  use?",No_o_bins 

376  Done^O 

378  Auto-0 

380  END  IF 

382  CLEAR  SCREEN 

384  RETURN 

386  Xy  histogram:  ! 

388  Range  - Wave(Pnts,  1 )-Wave(  1,1) 

390  IF  Range  > 1 .E-50  THEN 

392  Base  = 1 0AINT(LGT(Range)) 

394  SELECT  Range 

396  CASE  <=2*Base 

398  Factor -Base/5 

400  CASE  < -5*Base 

402  Factor  = Base/2 

404  CASE  < - 10® Base 

406  Factor  = Base 

408  END  SELECT 

410  ELSE 

412  Factor  =1 

414  END  IF 

41 6 Xmin  = Factor  * (INT(Wave{1 , 1 )/Factor)) 

41 8 Xmax  - Factor  * (INT(Wave(Pntsf  1 )/Factor)) 

420  Edgejt  = Xmin-.  55  # (Xmax-Xmini 

422  Edgejt  = Xmin-.  35*  (Xmax-Xmin) 

424  Delta  jc  = (Edge  jt-EdgeJt)/MAX(Histjiry  (* )) 

426  Coeff  = REAL(No_o_bins/(No_o_bins-1 )) 

428  Coeff2  = REAL(MAX(Hist_ary(*H/(MAX(Hist_ary(*))-1  )) 

430  FOR  I - 1 TO  Noj)J)ins 

432  Histogram(lf  lT=  Hist  ary  (I)  * Coeff  2 * De!ta_x  + Edgejt 

434  Histogram(l,2)  = (I- 1 )*  Coeff*  Del  tav  + Vmin 

436  NEXT  I 
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RETURN 


438 
440 

442  ! //////////////////////////////////////////////////////////// 

444  I 

446  Vmax  min  ptp:  ! 

448  Vmax-=  Wave  (1,2) 

450  Vmin  = Wave(1,2) 

452  FOR  1 = 1 TO  Pnts 

454  IF  Waved, 2)  < Vmin  THEN  Vmin  = Wave(l,2) 

456  IF  Wave(l,2)>  Vmax  THEN 

458  Vmax = Waved, 2) 

460  Maxpoint  = l 

462  END  IF 

464  NEXT  I 

466  Vptp = Vmax-Vmin 

468  RETURN 

470  SUBEND 

472  ! 

474  !## * 

476  ! 
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B.7  MATH  OPS 


100  ! RE-STORE  "MATH_OPS:,1400" 

102  COM  /Sys_msi/  Msi Jd  $ (20] 

104  COM  /Sys/  Sys_id$[10] 

106  COM  /Interrupts/  INTEGER  lntr_prty 
108  ! 

1 10  OUTPUT  KBD  USING  "K,#";"SCRATCH  KEYE"  ! ERASE  SOFT  KEYS 

1 12  CONTROL  KBD,15;0f  sets  the  color  of  the  soft  keys 
114  CONTROL  KBD, 2;  1 
1 1 6 lntr_prty  = 1 
1 1 8 CALL  Do  op 

120  OUTPUT  KBD  USING  "K,iT;"LOAD  KEYE*!  restore  the  typing  aid  keys 
122  PRINT  TABXY(1 ,5);"END  of  program.  So  long." 

124  MASS  STORAGE  IS  1400" 

126  ! 

128  END 
130  ! 

132  l-~ ■ — — — 

1 34  ! This  program  performs  simple  math  operations  on  waveform  data. 

1 36  ! You  may  add,  subtract,  multiply,  or  divide  (non-zero)  the  data 
138  ! by  a constant  or  you  may  integrate,  differentiate,  or  time  shift 
140  ! the  data. 

144  ! 

146  Datejine:  ! 

148  I S.  M.  Chesnut 

150  ! May  21,1991 

152  ! 

1 54  SUB  Do_op 
156  ! 

1 58  OPTION  BASE  1 

160  DEG 

1 62  COM  /Figs/  Stp Jig 

164  COM  /Interrupts/  INTEGER  Intrprty 

166  COM  /Files/  Diskdrive$[20],Filename$[14],Msj3ath$[500] 

168  COM  /Data_stuff/  INTEGER  Number, REAL  Delta  x,REAL  Strtjime 

170  COM  /Data_vars/  REAL  Wave(4096,2),Newj/vave(4096,2),INTEGER  Loaded 

172  I 

174  INTEGER  locai_prty,Basketsize 

176  DIM  DataJd$[40],Test$[20],Ch$m 

178  REAL  Last_pnt,Wavejnt,Time_plc 

1 80  Do_op:  I 

182  OFF  KEY 

184  OFF  KNOB 

186  OFF  KBD 

1 88  Interrupted  = 1 

1 90  Local^prty  = lntr_prty 

192  ! 

1 94  Basketsize  = 4096 

196  Filename$-“" 

198  Diskdrive  $ = 

200  Loaded -0 

202  Number  = 0 

204  LOOP 

206  IF  Interrupted  THEN  GOSUB  Menu 

208  ON  KEY  9 LABEL  "EXIT  \Localjjrty  4-  3 GOTO  Ret 
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210  END  LOOP 

212  Ret:  ! 

214  OFF  KEY 

216  CLEAR  SCREEN 

218  Stp  fig  = 1 

220  SUBEXIT 

222  I 

224  Menu:  ! 

226  CLEAR  SCREEN 

228  OFF  KEY 

230  OFF  KBD 

232  OFF  KNOB 

234  Interrupted  =0 

236  DISP  " Select  the  appropriate  soft  key  for  the  desired  operation.” 

238  ON  KEY  0 LABEL  "INTEGRATE",Local_prty  + 1 GOSUB  Integrate 

240  ON  KEY  2 LABEL  ”DIFFERENTIATE\Local_prty  + 1 GOSUB  Differentiate 

242  ON  KEY  4 LABEL  "LOAD  FILE\Local_prty  + 1 GOSUB  LoadjJata 

244  ON  KEY  6 LABEL  "TIME  SHIFT",  Local_prty  + 1 GOSUB  Cal_start_point 

246  ON  KEY  8 LABEL  "Y  + */-  CONST", Local  prty + 2 GOSUB  Call  const jnath 

248  RETURN 

250  ! 

252  I 

254  I 

256  Integrate:  I 

258  IF  NOT  Loaded  THEN 

260  BEEP 

262  DISP  "NO  FILE  IN  MEMORY,  PLEASE  LOAD  A FILE  FIRST." 

264  WAIT  1 .5 

266  RETURN 

268  CLEAR  SCREEN 

270  END  IF 

272  OFF  KEY 

274  OFF  KBD 

276  OFF  KNOB 

278  CLEAR  SCREEN 

280  Interrupted  = 1 

282  Timejjlc  = 0 

284  Last j)nt  = Waved,  2) 

286  New_wave(1,2)  =0 

288  FOR  1 = 2 TO  Number 

290  Wavejnt  = .5  * Delta_x  * (Last_pnt  + Waved, 2))  + New_wave(l-1 ,2) 

292  Lastj3nt  = Wave(l,2) 

294  New_wave(l, 2)  = Wavejnt 

296  Newj/vave(l,1 ) =Time_plc 

298  Time  pic  = TimejDlc  + Delta  jc 

300  NEXT  I 

302  CALL  Storejiew 

304  RETURN 

306  ! 

308  I 

310  * 

312  ! 

314  Differentiate:  ! 

316  IF  NOT  Loaded  THEN 

318  BEEP 

320  DISP  "NO  FILE  IN  MEMORY,  PLEASE  LOAD  A FILE  FIRST." 

322  WAIT  1.5 

324  RETURN 
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326  CLEAR  SCREEN 

328  END  IF 

330  OFF  KEY 

332  OFF  KBD 

334  OFF  KNOB 

336  Interrupted  = 1 

338  Timejjlc  * Delta_x 

340  Newj/vaved ,2)  =0 

342  New  waved  (1 ) = 0 

344  FOR  1 = 2 TO  Number 

346  New_wave(l,2)  = (Waved,  2)-Wave(l-1 ,2))/Delta_x 

348  New  j/vaved,  1 ) = Time_plc 

350  Time_plc~Time_plc  + Delta  x 

352  NEXT  I 

354  CALL  Store jiew 

356  RETURN 

358  S 

362  S 

364  loadjjlata:  ! 

366  Loaded  = 1 

368  lntr_prty  “ Local^prty  + 2 

370  CALL  Load_dlsk_data(Wave(*),Basketsize,DataJd$,0) 

372  lntr_prty  - Local_prty 

374  IF  Number -0  THEN 

376  BEEP 

378  DISP  "NO  FILE  WAS  READ,  PLEASE  TRY  AGAIN." 

380  WAIT  1 .5 

382  GOTO  Load_data 

384  END  IF 

386  REDINI  Wave(Number,2) 

388  REDIM  New_wave(Number,2) 

390  RETURN 

392  ! 

394  i*  ********  ***.**»»*«*»* **********  ******* 

396  i 

398  Cal_start_point:  I 

400  lntr_prty  = Local_prty  + 2 

402  CALL  Standpoint 

404  Intr  prty  ~ Local^prty 

406  RETURN  • 

408  ! 

410  I****** 

412  I 

414  Call_const_math:  I 

4 1 6 lntr_prty  ~ Locai_prty  + 2 

418  CALL  Const_math 

420  Intrprty  - Locai_prty 

422  RETURN 

424  SUBEND 
426  ! 

430  I 

432  SUB  Start_point 
434  S 

436  OPTION  BASE  1 
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438  DEG 

440  COM  /Figs/  Stp_flg 

442  COM  /Interrupts/  INTEGER  lntr_prty 

444  COM  /Files/  Diskdrive$(20],Filename$[141,Ms_path$[5001 

446  COM  /Data_vars/  REAL  Wave(4096,2),New_wave(4096,2), INTEGER  Loaded 

448  COM  /Data  stuff/  INTEGER  Number.REAL  Delta  x.REAL  Strt_time 

450  I 

452  INTEGER  Local_prty,lndx, Pointer 

454  REAL  Max_pnt,Min_pnt 

456  Start jjoint:  I 

458  PRINT  SYSTEM  $("  SYSTEM  PRIORITY") 

460  OFF  KEY 

462  OFF  KNOB 

464  OFF  KBD 

466  Interrupted  = 1 

468  Local  prty  = intr_prty 

470  IF  NOT  Loaded  THEN 

472  BEEP 

474  DISP  "THERE  IS  NO  FILE  IN  MEMORY,  PLEASE  LOAD  FIRST." 

476  SUBEXIT 

478  END  IF 

480  LOOP 

482  IF  Interrupted  THEN  GOSUB  Shiftmenu 

484  ON  KEY  9 LABEL  "EXIT  ".Local  prty + 5 GOTO  Ret 

486  END  LOOP 

488  Ret:  ! 

490  OFF  KEY 

492  CLEAR  SCREEN 

494  Stp  fig  = 1 

496  SUBEXIT 

498  Shiftmenu:  I 

500  Interrupted  = 0 

502  CLEAR  SCREEN 

504  OFF  KEY 

506  OFF  KBD 

508  OFF  KNOB 

510  DISP  "Select  the  appropriate  soft  key  for  the  new  t=0  point." 

512  ON  KEY  0 LABEL  "Max  value", Local_prty  + 1 GOTO  Maxval 

514  ON  KEY  2 LABEL  "Min  value", Local_prty  + 1 GOTO  Minval 

516  ON  KEY  4 LABEL  "Keyboard  input", Local_prty  + 1 GOTO  Keyjn 

518  RETURN 

520  Maxval:  I 

522  OFF  KEY 

524  OFF  KBD 

526  OFF  KNOB 

528  CLEAR  SCREEN 

530  Max_pnt  = -1 .0E  + 60 

532  FOR  I = 1 TO  Number 

534  IF  Wave(l,2)>Max_pnt  THEN 

536  Max_pnt  = Wave(l,2) 

538  lndx  = l 

540  END  IF 

542  NEXT  I 

544  GOSUB  Reorder 

546  CALL  Store  new 
548  SUBEXIT 
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550  Minval:  ! 

552  OFF  KEY 

554  OFF  KBD 

556  OFF  KNOB 

558  Min_pnt  = 1 .E  + 60 

560  FOR  I = 1 TO  Number 

562  IF  Wave(l,2)<Min_pnt  THEN 

564  Min_pnt-  Waved,  2) 

566  Indx  = I 

568  END  IF 

570  NEXT  I 

572  GOSUB  Reorder 

574  CALL  Store_new 

576  SUBEXIT 

578  Key  in:  I 

580  OFF  KEY 

582  OFF  KBD 

584  OFF  KNOB 

586  INPUT  "Enter  the  new  starting  point  index” , Indx 

588  GOSUB  Reorder 

590  CALL  Store_new 

592  SUBEXIT 

594  Reorder:  ! 

596  FOR  1 = 1 TO  Number 

598  Pointer  = Indx  + 1-1 

600  IF  Pointer  > Number  THEN  Pointer  = Pointer-Number 

602  Newjwave(l(2)  = Wave(Pointer,2) 

604  New_wave(lp1 ) -Waved,  1 ) 

606  NEXT  I 

608  RETURN 

610  SUBEND 
612  ! 

614  !*** 

616  ! 

618  SUB  Store_new 
620  I 

622  OPTION  BASE  1 

624  DEG 

626  COM  /Interrupts/  INTEGER  lntr_prty 

628  COM  /Files/  Diskdrive$[20LFilename$[141,Ms_path$[500J 

630  COM  /Data_vars/  REAL  Wave(4096,2),New_wave(4096,2),INTEGER  Loaded 

632  COM  /Data  stuff/  INTEGER  Number,REAL  Delta_x,REAL  Strt_time 

634  ! 

636  INTEGER  Local_prty 

638  I 

640  Storenew:  ! 

642  Local_prty  = lntr_prty 

644  Filename$  = 

646  Diskdrive$  = B" 

648  INPUT  "Enter  a 40  char,  (or  less)  data  description.", Data Jd$ 

650  Intr  prty  = Localprty  + 1 

652  CALL  Data_to_disk_r(1  , Number, New_wave(fl),Datajd$) 

654  Intrprty  = Localprty 

656  Loaded  = 0 

658  SUBEXIT 

660  SUBEND 
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662  ! 

664  ! 

666  ! 

668  SUB  Const_math 
670  ! 

672  OPTION  BASE  1 

674  DEG 

676  COM  /Figs/  StpJIg 

678  COM  /Interrupts/  INTEGER  lntr_prty 

680  COM  /Files/  Diskdrive$l20],Filename${14],Msj)ath$[500] 

682  COM  /Data_stuff/  INTEGER  Number, REAL  Delta_x,REAL  Strt_time 

684  COM  /Data_vars/  REAL  Wave(4096,2),New  wave(4096, 2), INTEGER  Loaded 

686  ! 

688  INTEGER  Local_prty 

690  REAL  Last_pnt,WaveJnt,Time_plc 

692  Const_math:  I 

694  OFF  KEY 

696  OFF  KNOB 

698  OFF  KBD 

700  Interrupted  = 1 

702  Local_prty  = lntr_prty 

704  IF  NOT  Loaded  THEN 

706  BEEP 

708  DISP  "THERE  IS  NO  FILE  IN  MEMORY,  PLEASE  LOAD  FIRST/ 

710  SUBEXIT 

712  END  IF 

714  LOOP 

716  IF  Interrupted  THEN  GOSUB  Const_menu 

718  ON  KEY  9 LABEL  "EXIT  ",Local_prty  + 3 GOTO  Ret 

720  END  LOOP 

722  Ret:  I 

724  OFF  KEY 

726  CLEAR  SCREEN 

728  StpJIg  = 1 

730  SUBEXIT 

732  I 

734  Constjnenu:  I 

736  Interrupted  = 0 

738  CLEAR  SCREEN 

740  OFF  KEY 

742  OFF  KBD 

744  OFF  KNOB 

746  DISP  "Select  the  appropriate  soft  key  for  the  desired  operation.” 

748  ON  KEY  0 LABEL  "ADD",Local_prty  + 1 GOTO  Add 

750  ON  KEY  2 LABEL  " SUBTRACT", Local_prty  + 1 GOTO  Sub 

752  ON  KEY  4 LABEL  " MULTIPLY", Local_prty  + 1 GOTO  Mult 

754  ON  KEY  6 LABEL  "DIVIDE",Local_prty  + 1 GOTO  Divide 

756  RETURN 

758  I 

760  I 

762  Add:  ! 

764  OFF  KEY 

766  OFF  KBD 

768  OFF  KNOB 

770  CLEAR  SCREEN 

772  GOSUB  Get_const 
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774  FOR  I = 1 TO  Number 

776  Waved, 2}  = Waved, 2)  + Const 

778  NEXT  I 

780  CALL  Store_new 

782  SUBEXIT 

784  Sub:  I 

786  OFF  KEY 

788  OFF  KBD 

790  OFF  KNOB 

792  CLEAR  SCREEN 

794  GOSUB  Get_const 

796  FOR  1 = 1 TO  Number 

798  Waved,2)=  Waved, 2)-Const 

800  NEXT  I 

802  CALL  Store  new 

804  SUBEXIT 

806  Mult:  l 

808  OFF  KEY 

810  OFF  KBD 

812  OFF  KNOB 

814  CLEAR  SCREEN 

816  GOSUB  Get_const 

818  FOR  I * 1 TO  Number 

820  Waved, 2)  - Waved, 2)  * Const 

822  NEXT  \ 

824  CALL  Store_new 

826  SUBEXIT 

828  Div_err:  ! 

830  BEEP 

832  DISP  "DIVISION  BY  ZERO  IS  NOT  ALLOWED." 
834  WAIT  1 .0 

836  DISP  "Input  a new  constant.” 

838  WAIT  1.0 

840  GOSUB  Get_const 

842  Divide:  I 

844  OFF  KEY 

846  OFF  KBD 

848  OFF  KNOB 

850  CLEAR  SCREEN 

852  GOSUB  Get_const 

854  IF  Const <>0  THEN 

856  FOR  1 = 1 TO  Number 

858  Waved, 2)  = Waved, 2)/Const 

860  NEXT  I 

862  CALL  Store jiew 

864  SUBEXIT 

866  ELSE 

868  GOTO  Div_err 

870  END  IF 

872  Const  error:  I 

874  CLEAR  SCREEN 

876  BEEP 

878  DISP  "ERROR  IN  CONSTANT  INPUT,  try  again." 
880  WAIT  1 .0 

882  Getjsonst:  I 

884  CLEAR  SCREEN 
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886  ON  ERROR  GOTO  Const_error 

888  INPUT  "What  is  the  value  of  the  constant?", Test$ 

890  Const  = VAL(Test$) 

892  OFF  ERROR 

894  RETURN 

896  1 

898  SUBEND 
900  ! 

902  I 

904  I 

906  SUB  Load_disk_data(Basket_file{#), INTEGER  Basketsize,Data_id$, INTEGER  Fig) 

908  Load_disk_data:  I Original:  1 3 Nov  1 984 

910  ! Revision:  02  Dec  1987 

912  IThis  routine  will  enter  data  files  from  the  disk 

914  OPTION  BASE  1 

916  I 

918  COM /Sys/ Sys_id$ 

920  COM  /History/  Status$[1],Time_orgn$[81,Date_orgn$[1 1] 

922  COM  /History/  Time  chng$[8],Date_chng$[1 1],Description$[1 60] 

924  1 

926  COM  /Labels/  Labels$(30)[60], INTEGER  Lbl_count,REAL  Lbl_addr(30,6) 

928  !Lbl_addr:  x,  y,  pen,  size,  LDIR,  LORG 
930  1 

932  COM  /Data_param/  INTEGER  Datacount,Filesize,Curvecount,Roster(1 7,4) 

934  COM  /Data_param/  REAL  Sym_size,Symbol$(17)[2],CurveJd$(1 7)[40] 

936  COM  /Data_param/  REAL  Xmin_data,Xmax_data 

938  COM  /Data_param/  REAL  Ymin  data,Ymax  data 

940  I 

942  IRoster:  Curve#,  Start  Addr  in  File(#),  Datacount,  and  PEN 
944  !Symbol$(i)  = ""  or  "Y"  = > no  symbol,  connect  pts 
946  !Symbol$(i)  = "*Y"  =>  * symbol,  connect  pts 
948  !Symbol$(i)  = "*N"  =>  * symbol,  do  not  connect  pts 
950  I 

952  COM  /Background/  Graphtype$H  2],Margins$(2)[10],Papersize$(1] 

954  COM  /Background/  REAL  Pen_speed, INTEGER  Backgnd_pen,Auto_time 

956  COM  /Background/  INTEGER  Auto_file,REAL  X_cross_y,Y_cross_x 

958  COM  /Background/  Xgrid=tick$(4], INTEGER  Xmajor,Xminor 

960  COM  /Background/  Ygrid_tick$ [4], INTEGER  Ymajor,Yminor 

962  COM  /Background/  REAL  Xmin_graph,Xmax_graph,Ymin  graph, Ymax_graph 

964  ! 

966  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

968  COM  /Interrupts/  INTEGER  lntr_prty 

970  COM  /Enlargejile/  INTEGER  Overflow 

972  COM  /Files/ Diskdrive$[20],Filename$(14],Ms_path$[500] 

974  COM  /Data_stuff/  INTEGER  Number, REAL  Delta_x,REAL  Strt_time 

976  ! 

978  INTEGER  R,Hold_size,Local_prty,  Allocated, Fls_cnt 

980  DIM  Ac$[5],Tempfiie${10],Mask$(10],Ftype$[5],Fls$(1 )[  1 4] 

982  REAL  Dtime 

984  OFF  KEY 

986  Local_prty  =lntr_prty 

988  I 

990  ISelect  the  disk  drive  where  the  data  exists 
992  I 

994  IF  Overflow  < > 0 THEN  Overflow  = 0 

996  Hold  size  = 0 
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998  Dtime  = 0. 

1000  Allocated  = 0 

1002  Selectdrive:  I 

1 004  IF  Diskdrive  $ = "NO  DISK*  THEN  Diskdrive$  « " 

1006  IF  LEN(Diskdrive$)>0  THEN  GOTO  Choosefilename 

1008  GRAPHICS  OFF 

1010  OUTPUT  2 USING  "#,K*;"K" 

1012  CALL  Select_disk 

1014  IF  Diskdrive  $ -"NO  DISK"  THEN  GOTO  Mistakelineset 

101 6 Choosefilename:  I 

1018  Tempfile$  =Filename$ 

1020  IF  LEN(Filename$)>0  THEN  GOTO  Bring _in_data 
1022  Ac$  - "CAT" 

1024  CALL  Enterfilename(Ac$) 

1026  IF  LEN(Filename$)-0  OR  POS(Filename$#,9*")>  1 THEN 

1028  IF  POS(Fiiename$c" * ") > 1 THEN  ! set  mask$ 

1 030  Mask$  - Filename${1  ,POS(FiIename$,"  * "}-1  ] 

1032  Filename^-"* 

1 034  ELSE 

1036  Mask$  = ""!  no  preselection 

1038  END  SF 

1040  Ftype$™cBDAT  * I examine  BDAT  files  only 

1 042  Flsjsnt  - 1 l select  one  file 

1 044  lntr_prty  = Local^prty  + 1 

1046  CALL  File_menu(Mask$,Ftype$,Fls$(#),Fls_entAO$ 

1 048  Intrjjrty  = Local_prty 

1050  Filename^  = Fls$(1 ) 

1052  IF  LEN(Filename$)  =0  THEN  I aborted 

1054  Filename  $ =Tempfile$ 

1056  GOTO  Mistakelineset 

1058  END  IF 

1060  END  IF 

1062  Bring i in_data:  I 

1064  ! 

1 066  l Find  this  file  on  the  disk. 

1068  I 

1 070  ON  ERROR  GOTO  Cant Jindfile 

1072  ASSIGN  @Datapath  TO  Filename$&Diskdrive$ 

1074  OFF  ERROR 

1076  Dtime  -TIMEDATE 

1078  DISP  " LOADING  disk  file:  ";Filename$;B  ... 

1080  ON  ERROR  GOTO  Badjile 

1082  ENTER  @Datapath;Status$ 

1084  OFF  ERROR 

1086  ON  ERROR  GOTO  Cant  findfile 

1088  SELECT  Status  $ 

1090  CASE  "Y"  ! All  graphics/data  parameters  exist.REN  100f2 

1092  DISP  " Complete  graph.  " 

1094  ENTER  @Datapath;Time_orgn$,Date_orgn$ 

1096  ENTER  @Datapath;Time_chng$fDate_chng$ 

1098  ENTER  @Datapath;Description$ 

1100  ENTER  @Datapath;Labels$(*),Lbl_count,Lbl_addr(*) 

1102  ENTER  @Datapath;CurveJd$(*),Symbol$(#) 

1104  ENTER  @Datapath;Roster(*LCurvecount 

1106  ENTER  @Datapath;Graphtype$,Margins$(*) 

1108  ENTER  @Datapath;X_cross_y,Y_cross_x 
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1110  ENTER  @Datapath;Xgrid_tick$,XmajorfXminor 

1112  ENTER  @Datapath;Ygrid_tick$,Ymajor,Yminor 

1114  ENTER  @Datapath;Xmin_graph,Xmax_graph 

1116  ENTER  @Datapath;Ymin_graph,Ymax_graph 

1118  CASE  "N"  ! Only  data  parameters  exist. 

1120  DISP  " RAW  data.  " 

1122  CASE  ELSE 

1124  Badjile:  DISP  CHR$(12) 

1126  DISP  "Data  file  is  not  recognized,  entry  aborted."; 

1128  DISP  " ...continue." 

1130  BEEP 

1 1 32  PAUSE 

1 1 34  OFF  ERROR 

1 1 36  GOTO  Mistakeiineset 

1138  END  SELECT 

1140  I 

1142  ENTER  @Datapath;Data_id$ 

1144  IF  Fig  THEN 

1 1 46  ENTER  @Datapath;Delta_x 

1 1 48  ENTER  @Datapath;Datacount 

1 1 50  Hold  size  = Datacount 

1 1 52  ELSE 

1 1 54  ENTER  @Datapath;Datacount 

1 1 56  ENTER  @Datapath;Hold_size 

1158  END  IF 

1160  IF  NOT  Allocated  THEN 

1162  IF  Datacount > = 1 AND  Hold_size>  = 1 THEN 

1 1 64  ALLOCATE  Holding  file(Hold  size, 2) 

1166  ELSE 

1 1 68  ALLOCATE  Holding  filed  ,2) 

1170  END  IF 

1172  Allocated  = 1 

1174  END  IF 

1176  ENTER  @Datapath;Holding  filed) 

1178  ASSIGN  ©Datapath  TO  # ’ 

1 1 80  OFF  ERROR 

1182  IF  NOT  Fig  THEN 

1 1 84  Delta_x  = Holding  _file(2, 1 )-Holding_f  ile(  1,1) 

1186  Strt  time  = Holding_file(  1,1) 

1 1 88  END  IF 

1190  IF  Datacount  = 0 THEN  Mistakeline 

1192  I 

1 194  ICopy  data  from  Holding_filed)  to  Basket_filed) 

1196  ! 

1 1 98  MAT  Basketjile  = (0.) 

1200  IF  Datacount > Basketsize  THEN  IReceiving  file  too  small. 
1202  Allocated  =0 

1 204  DEALLOCATE  HoldingJ ile( * ) 

1206  DISP  " DATA  FILE  overflow,  new  data  discarded.  "; 

1208  DISP  " (continue)  " 

1210  BEEP 

1212  PAUSE 

1214  IF  Status$  = "Y"  THEN 

1216  Curvecount  = 0 

1218  MAT  Roster=  (0) 

1220  END  IF 
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1222  Overflow  = Hold_size 

1 224  GOTO  Mistakelineset 

1226  END  IF 

1 228  Copydatafile:  I 

1230  FOR  R = 1 TO  Datacount 

1 232  Basket : file(R,  1 ) = Holding  _file(R,  1 ) 

1 234  Basket :”f  ile(R,2)  = Holding  file(R, 2) 

1236  NEXT  R 

1 238  Number  --  Datacount 

1240  GOTO  Mistakeline 

1242  l 

1 244  Mistakelineset:Datacount  = 0 
1 246  Mistakeline:OFF  KEY 

1248  IF  Allocated  THEN  DEALLOCATE  HoldingJileC) 

1 250  LOOP 

1 252  EXIT  IF  TSMEDATE-Dtime >1.8 

1254  END  LOOP 

1256  DISP  CHR$|1 2| 

1258  OUTPUT  2 USING  "#,K";"K" 

1260  SUBEXIT 

1262  ! 

1 264  5 //////////////////////////////////////////////////////// 

1266  I 

1 268  Cant_findfile:  lError  in  searching  for  the  file. 

1270  BEEP  §00,.  6 

1272  SELECT  ERRN 

1274  CASE  56 

1276  DISP  "That  file  does  not  exist  on  this  disk 

1278  CASE  72,73,76,82 

1280  DISP  Diskdrive$;"  has  failed  or  is  not  available 

1282  CASE  ELSE 

1284  DISP  ERRM$; 

1 286  END  SELECT 

1288  DISP  " ....CONTINUE  to  try  again." 

1 290  PAUSE 

1292  Filename^-”" 

1294  Diskdrive  $ = 

1296  GOTO  Selectdrive 

1298  S 

1 300  SUBEND 

1 302  I , 

1304  I *.*.**#*****.•**«.*#*«** 

1306  S 

1308  SUB  Data_to_disk_r(INTEGER  Curve, Datacount, REAL  Basket_file(*),Data_id$) 
1310  Data_to_disk_r:  I Original:  13  Nov  1984 
1312  ! Revision:  02  Dec  1987 

1314  IThis  routine  will  SAVE  data  files  on  the  disk  in  RAW  data  format. 

1316  OPTION  BASE  1 

1318  COM  /Files/  Diskdrive${20],Filename$(14],Ms_path$[500] 

1 320  COM  /Interrupts/  INTEGER  Intrjsrty 

1322  INTEGER  Local j3rty,Diskspaee 

1324  DIM  Ac$(51,Status$(1  ],Tempfile$|1 4] 

1 326  REAL  Dtime 

1328  OFF  KEY 

1 330  Loca!_prty  = Intr^prty 

1332  Dtime  = 0. 
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1334  ! 

1 336  (Select  the  disk  drive  for  data  storage 

1338  ! 

1 340  Selectdrive:  ! 

1342  GRAPHICS  OFF 

1344  OUTPUT  2 USING  "#,K";"K" 

1 346  CALL  Select  disk 

1348  IF  Diskdrive$"="NO  DISK"  THEN  GOTO  Mistakeline 
1 350  Choosefilename:  I 
1352  Ac$  = "ABORT" 

1354  Tempfile$  = Filename$ 

1356  CALL  Enterfilename(Ac$) 

1 358  IF  LEN(Filename$)  = 0 THEN 

1360  Filename$  =Tempfile$ 

1362  GOTO  Mistakeline 

1364  END  IF 

1 366  Send_to_disk:  I Create  file  and  save  information. 

1368  ON^RROR  GOTO  Cant_savedata 

1 370  Diskspace  = INT((Datacount#  1 6.0)/256)  + 2 

1372  CREATE  BDAT  Ms  path$&Filename$&Diskdrive$,Diskspace,256 

1374  Dtime = TIMED  ATE 

1376  DISP  " SAVING  data  for  CURVE  # ";Curve;".  " 

1378  Status$  = "N" 

1380  ASSIGN  ©Datapath  TO  Ms_path$&Filename$&Diskdrive$ 

1382  OUTPUT  @Datapath;Status$ 

1384  OUTPUT  @Datapath;Data_id$  140  chrs  description  if  single  curve 

1386  OUTPUT  ©Datapath, -Datacount  (number  of  xy  points 

1388  OUTPUT  @Datapath;Datacount  (size  of  array  (same  as  above) 
1390  OUTPUT  @Datapath;Basket_file(#) 

1 392  ASSIGN  ©Datapath  TO  * 

1394  OFF  ERROR 

1396  I 

1 398  Mistakeline:OFF  KEY 
1 400  LOOP 

1 402  EXIT  IF  TIMED ATE-Dtime  >1.8 

1 404  END  LOOP 

1406  DISP  CHR$(1 2) 

1408  OUTPUT  2 USING  "#,K";"K" 

1410  SUBEXIT 

1412  I 

1414  1 //////////////////////////////////////////////////////// 

1416  I 

1418  Cant_savedata:  I 

1420  BEEP  500, .6 

1422  SELECT  ERRN 

1424  CASE  72,73,76,78,81,82,90,93 

1426  DISP  Diskdrive$;”  has  failed  or  is  not  available  "; 

1428  DISP  " ....CONTINUE  to  try  again." 

1430  CALL  Pause_key__on 

1432  Filename$  =Tempfile$ 

1434  CASE  84,85 

1436  DISP  " This  disk  is  not  initialized  "; 

1438  DISP  " ....CONTINUE  to  try  again." 

1440  CALL  Pause_key_on 

1442  Filename$  =Tempfile$ 

1444  CASE  55,64 
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1446  DISP  " This  disk  is  full,  insert  new  floppy  and/or"; 

1448  DISP  " select  new  drive  ...CONTINUE  " 

1 450  CALL  Pause_key_on 

1452  Filename$  =Tempfile$ 

1454  CASE  ELSE 

1 456  CALL  Errortrap 

1458  GOTO  Send_to_disk 

1460  END  SELECT 

1462  GOTO  Selectdrive 

1464  I 

1466  SUBEND 
1468  ! 

1470  I *** * ******###**##*#***##**## *********** 

1472  I 

1474  SUB  Selectjlisk 
1476  Select_disk:  ! Original:  13  Nov  1984 
1478  ! Revision:  02  Dec  1987 

1480  OPTION  BASE  1 

1482  COM  /Files/  Diskdrive$[201,Filename$n41,Msj>ath$[500I 

1484  COM  /Interrupts/  INTEGER  lntr_prty 

1486  COM  /Sys_msi/  Msi  id$ 

1488  COM  /Sys/  Sys_.d$' 

1490  INTEGER  Local_prtyfDd» Ft, Choose (1 1 

1492  DIM  Disc$(30)[60LTitle$[40],Displ$[601 

1494  Local_prty  = Intr  prty 

1496  OFF  KEY 

1498  l 

1 500  ! Define  the  disk  drives  available  for  this  system,,  reserve  the 

1 502  I first  characters  for  the  drive  address  and  the  characters  after 

1 504  I the  = for  a description  of  the  drive. 

1506  I 

1508  I Example: 

1510  I Disc$(1)  = ’:,70Qf0,0  HP  91 33H  HARD  disk,  volume  0." 

1512  I 

1514  I 

1516  Displ$  = " SELECT  DISK  DRIVE  ...  Abort  will  cancel.  B 
1518  Title  $ “ " Available  disk  drives  for  this  system.  B 

1520  Pt  = 1 ! allow  only  one  select 

1522  S 

1524  IF  Diskdrive$[1f1]<>B:B  THEN  Diskdrive  $ — 

1526  IF  Msi  id${1,1]<  >":"  THEN  M«sijd$  - SYSTEM $C MSI") 

1528  IF  Msi Jd$[1,1  ]<>’:"  THEN  ! Must  be  HFS  subdirectory 

1530  Ms_path$  = MsiJd$[1,POS(MsiJd$,":")*1j  ! strip  off  subdirs 

1532  IF  Ms  path${LEN(Ms__path$);1]<  >"/"  THEN  Ms  path$  = Ms_path$&"/" 

1534  Msi  Jd  $ = Msi  id  $ [POS(Msi  Jd  $ „ " : " ),LEN(Msi  Jd  $ )) 

1 536  END  IF 

1 538  Diskdrive$  =TRIM$(Diskdrive$) 

1540  Msijd$  - TRIM  $ (Msi  Jd$) 

1542  IF  LEN(Diskdrive$)>0  AND  LEN(Msi  id$)>0  THEN 

1544  Disc$(1  ) = Diskdrive $&RPT$C  ",17-LEN(Diskdrive$)) 

1546  Disc$U ) = Disc$(1  )&"-  Last  selected  disk  drive." 

1 548  Dd  = 1 

1 550  IF  Diskdrive$  < > Msi  id$  THEN 

1552  ' Disc$(2)  = MsiJd$&RPT$("  \17-LEN(MsiJd$)) 

1554  Disc$(2)  = Disc$(2)&"-  Start-up  mass  storage  unit  specifier." 

1556  Dd  = Dd  + 1 
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1558 

1560 

1562 

1564 

1566 

1568 

1570 

1572 

1574 

1576 

1578 

1580 

1582 

1584 

1586 

1588 

1590 

1592 

1594 

1596 

1598 

1600 

1602 

1604 

1606 

1608 

1610 

1612 

1614 

1616 

1618 

1620 

1622 

1624 

1626 

1628 

1630 

1632 

1634 

1636 

1638 

1640 

1642 

1644 

1646 

1648 


ELSE 

Disc$(1 ) = Disc$(1  )&"  Start-up  MSUS." 

END  IF 
ELSE 

IF  LEN(Msi  id$)  > 0 THEN 

Disc  $ ( 1 7=  Msijd  $ &RPT  $ ("  ",  1 7-LEN  (Msi  Jd  $ )) 

Disc$(1 ) = Disc$(1  )&"-  Start-up  mass  storage  unit  specifier." 
Dd  = 1 
ELSE 
Dd  = 0 
END  IF 
END  IF 
Disk:  I 

l customize  system  drives  here 

I Follow  format  with  - after  unit  specifier,  description  is 
I optional  but  recommended. 


Disc$(Dd  + 1)  = ":, 702,0 
Disc$(Dd  + 2)  = ":, 702,1 
Disc$(Dd  + 3)  = ":,703,0 
Disc$(Dd  + 4)  = ":,1 400 


- HP  9122  dual  microfloppy  left  drive" 

- HP  9122  dual  microfloppy  right  drive" 

- HP  9125  single  5.25  floppy  drive" 

- HP  9133H  hard  disk  volume  1" 


Dd  = Dd  + 4 I add  the  number  of  drive  specifiers  above 
I 

IF  Sys_id$[1 ,4]  < > "S300"  THEN 

Disc$(Dd  + 1)  = ":,4,1  - LEFT  internal  series  200" 

Disc$(Dd  + 2)  = ":,4,0  - RIGHT  internal  series  200" 

Dd  = Dd  + 2 
END  IF 


I 

CALL  Menu_scroll(Displ$,Title$,Disc$(#),Dd,Pt,Choose(#)) 

IF  Pt  = 0 THEN 

Diskdrive  $ = "NO  DISK" 

ELSE 

Dd  = POS(Disc$(Choose(Pt)),"-")-1  ! find  - 
IF  Dd>5  THEN  ! valid  msus 

Diskdrive$  =TRIM$(Disc$(Choose(Pt))[1  ,Ddl) 

ELSE 

DISP  " ERROR  in  reading  MSUS  from  string,  - chr  not  found.  " 
BEEP 

CALL  Pause  key  jan 
Diskdrive  $ - "NO  DISK" 

END  IF 
END  IF 


1 650  Diskselected:OFF  KEY 


1652  SUBEXIT 

1654  SUBEND 
1656  ! 

1658  ! 

1660  I 

1662  SUB  Enterfilename(Ac$) 

1 664  Enterfilename:  ! Original:  1 3 Nov  1 984 

1666  I Revision:  10  Dec  1990  includes  HFS  directories 

1668  OPTION  BASE  1 
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1670 

1672 

1674 

1676 

1678 

1680 

1682 

1684 

1636 

1688 

1690 

1692 

1694 

1696 

1698 

1700 

1702 

1704 

1706 

1708 

1710 

1712 

1714 

1716 

1718 

1720 

1722 

1724 

1726 

1728 

1730 

1732 

1734 

1736 

1738 

1740 

1742 

1744 

1746 

1748 

1750 

1752 

1754 

1756 

1758 

1760 

1762 

1764 

1766 

1768 

1770 

1772 

1774 

1776 

1778 

1780 


COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

COM  /Interrupts/  INTEGER  lntr_prty 
INTEGER  l,Ascii_num,Maskflag,Namelength 
DIM  Test$[256],Hfs_temp$[161] 

Namelength  = 1 0 

IF  LEN(Msj3ath$)>Q  THEN  OUTPUT  KBD  USING  "K,#";"#"&Ms  path$&"H" 
DISP  " ENTER  HFS  directory  PATH  (no  file)"; 

IF  Ae$  < > "PATH*5  THEN 

DISP  ",  ENTER  / for  HFS  ROOT  or  null  for  UF..„"; 

END  IF 

UN  PUT  Hfs_temp$ 

Hfs_temp$  = TRIM  $ (Hf  s temp  $ ) 

IF  LEN(Hfs_temp$)  >0  THEN 

IF  LEN(Hfs_temp$)>  1 AND  Hfs_temp$(LEN(Hfs_temp$);1]  < >"/"  THEN 
Hfs„temp$  = Hfs_temp$&"/" 

END  IF 

IF  LEN(Hfs_temp$)  = 1 THEN  Hfsjemp$  = "" 

Namelength  * 1 4 
END  IF 

IF  Ae$  - "PATH"  THEN 
Ms_path$  = Hfs  tempi 
SUBEXIT 
END  IF 

IF  LEN (Filename $ ) > Q THEN  OUTPUT  KBD  USING  "K,r;"#"&Filename$&"H" 
Efn:  I 

DISP  " ENTER  the  FILE  NAME  ... 

SELECT  Ae$ 

CASE  "CAT" 

DISP  ° (ENTER  CAT  mask*  or  ENTER  null  to  CAT)"; 

CASE  "ABORT" 

DISP  "(ENTER  null  to  ABORT)  \- 
CASE  "VALID" 

DISP  "(must  be  a VALID  namel) 

END  SELECT 
LINPUT  Test$ 

Test$  -TRIM$(Test$) 

IF  LEN(Test$)  =0  AND  Ac$  ~ "VALID"  THEN  GOTO  Enterfilename 
IF  LEN(Test$)  -0  THEN  Abortline 
IF  LEN(Test$)> Namelength  THEN 
BEEP 

'DISP  "ERROR  in  NAME  ENTRY  = max  ";Namelength;"  chars,  you  have 
DISP  LEN  (Test  $);"  " 

WAIT  1.8 

OUTPUT  2 USING  "K,#"  ;"#"&Test$&"H" 

GOTO  Efn 
END  IF 

IF  POS(Test$,"*")  > 1 THEN 

Test$  =Test$[1  ,POS(Test$,"  *")-1 ) 

Maskf  lag  = 1 
ELSE 

Maskf  lag  = 0 
END  IF 

FOR  1 = 1 TO  LEN  (Test  $) 

Asciijnum  = NUM(Test${l]j 
SELECT  Ascii_num 

CASE  65  TO  90,95,97  TO  122,48  TO  57 
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1782 

1784 

1786 

1788 

1790 

1792 

1794 

1796 

1798 

1800 

1802 

1804 

1806 


Filename$  =Test$&"*" 
ELSE 


END  SELECT 
NEXT  I 

IF  Maskflag  THEN 


CASE  ELSE 
BEEP 

DISP  "ERROR  in  NAME  ENTRY-ILLEGAL  CHARACTERS,  TRY  AGAIN. 
WAIT  1.8 

OUTPUT  2 USING  "K,#";"#"&Test$&"H* 

GOTO  Efn 


Filename$  =Test$ 


(Allowed  characters 


1808  END  IF 

1810  Ms_path$  = Hfs  temp$ 

1812  SUBEXIT 

1814  Abortline:Filename$  = "" 

1816  IF  Ac$  - "CAT"  THEN  Ms_path$  = Hfs_temp$ 

1818  SUBEXIT 

1 820  SUBEND 
1822  I 


1826  ! 

1828  SUB  File_menu(Mask$,Ftype$,Fls${*), INTEGER  Fls_cnt,Dir_on,Prt_on) 

1 830  Filejnenu:  ! 

1832  I Original:  29  Jun  1987,  G.  Koepke 

1834  I Revision:  02  Dec  1987,  07:00 

1836  OPTION  BASE  1 

1838  DEG 

1 840  COM  /Sys/  Sys_id$I1 0] 

1 842  COM  /Files/  Diskdrive$[20],Filename$[1 4],Ms_path$[500] 

1 844  COM  /Interrupts/  INTEGER  lntr_prty 

1846  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

1848  DIM  Directory$(600)[80],Bd$(600)(71] 

1850  DIM  D$[801,T$[51],lds$[40],Stat$[1],Test$[256] 

1 852  INTEGER  Bd_cnt,File_cnt,l,C_cnt,C0(1  ),Format_error,End_search 

1854  IF  FIs  cnt>0  THEN  ALLOCATE  INTEGER  Choosers  jsnt) 

1856  ! 

1 858  ! Catalog  the  disk  specified 

1860  ! 

1862  End_search  = 0 

1864  REPEAT  ! Generate  path  to  file  and  extract  file  name. 

1 866  ON  ERROR  GOTO  Cat_errors 

1 868  DISP  B Reading  the  Directory  ...  B 

1 870  IF  LEN(Ms_path$)  > 0 THEN 

1872  MASS  STORAGE  IS  Ms  path$[1  ,LEN(Ms_path$)-1]&Diskdrive$ 

1874  ELSE 

1876  MASS  STORAGE  IS  Diskdrive$ 

1878  END  IF 

1880  CAT  TO  Directory $C);NO  HEADER, COUNT  File_cnt 

1 882  OFF  ERROR 


1824  ! 


1884 

1886 

1888 

1890 

1892 


Bdcnt  = 0 
MAT  Bd$  = {"") 


I set  up  array  of  legal  file  names. 
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1894 

1896 

1898 

1900 

1902 

1904 

1906 

1908 

1910 

1912 

1914 

1916 

1918 

1920 

1922 

1924 

1926 

1928 

1930 

1932 

1934 

1936 

1938 

1940 

1942 

1944 

1946 

1948 

1950 

1952 

1954 

1956 

1958 

1960 

1962 

1964 

1966 

1968 

1970 

1972 

1974 

1976 

1978 

1980 

1982 

1984 

1986 

1988 

1990 

1992 

1994 

1996 

1998 

2000 

2002 

2004 


i 


FOR  I = 1 TO  File_cnt 

SELECT  Directory  $(l)[32, 36) 

CASE  Ftype$  ! Ftype$  - "BDAT  B or 

! Ftype$  = "PROG  " 

IF  lEN(Mask$)>0  THEN  ! Test  for  mask$ 

IF  Directory  $ (l)[  1 tlEN(Mask$)]  = Mask$  THEN 
Bd_cnt  = Bd_cnt  + 1 

Bd$(BdDcnt)  = Directory$(IH1;14]&”  - ”&Ftype$ 

END  IF 
ELSE 

Bd_cnt  = Bd  cnt  + 1 

Bd$(Bd_cnt)  = Directory$(l)[1;14]&"  - "&Ftype$ 

END  IF 

CASE  "DIR  * I plus  all  "DIR  " listings 

Bd _cnt  ~ Bd.  cnt  + 1 

Bd$(Bd_cntj"=  Directory  $(l)[1;14]&"  - DIR  " 

CASE  ELSE 
END  SELECT 
NEXT  I 

IF  LEN(Ms_path$)  > 0 AND  Bd_cnt>0  AND  Fls_cnt>0  THEN 
Bd  cm. » Bd  cm  + 1 

Bd$fBd=cnt)  ~ MOVE  back  up  ONE  Directory  level.® 
Bd_cnt  ” Bd  cnt  + 1 

Bdi(Bd_cnt)  ~ RETURN  to  ROOT  Directory." 

END  IF 
1 

I set  up  file  menu 
! 

D$-°  Select  "&VAL$(F!s_cnt)&®  file  name(s)  for  data  entry.® 

T$  = "List  of  "&Ftype$&"files  and  DIRs  on  "&Diskdrive$ 

IF  LEN(Mask$)>0  THEN 
T$-T$&"  mask-"&Mask$ 

END  IF 

IF  Bd  cnt  > 0 THEN 

IF  Dir_on>0  THEN  GOSUB  Read_datajd 
IF  Prt_on  THEN 

GOSUB  List_directory 
End_search  - 1 
ELSE 

C_cnt « Fis^cnt 
DISP  CHR$(1 2) 

IF  Fls^cnt  > 0 THEN 

CALL  Menu_scroll(D$5T$„Bd$(*hBd_cntcC_cnt, Choose!*)) 
ELSE 

CALL  Menu_scroll  (D  $ , ' T$ , Bd  $ ! # ) , Bd_cnt, C_cnt,  CO ( * ) ) 

END  IF 
I 

I transfer  file  names  to  Fls$(#). 

I 

IF  C ent  = 0 THEN  ! selection  process  aborted 
End_search  = 1 
MAT  Fls$  = ("") 

ELSE 

MAT  SORT  Choose!  *) 

FOR  1 = 1 TO  C cnt 

IF  Bd$!Choose(l))(1 8,22)  -Ftype$  THEN 
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2006 

2008 

2010 

2012 

2014 

2016 

2018 

2020 

2022 

2024 

2026 

2028 

2030 

2032 

2034 

2036 

2038 

2040 

2042 

2044 

2046 

2048 

2050 

2052 

2054 

2056 

2058 

2060 

2062 

2064 

2066 

2068 

2070 

2072 

2074 

2076 

2078 

2080 

2082 

2084 

2086 

2088 

2090 

2092 

2094 

2096 

2098 

2100 

2102 

2104 

2106 

2108 

2110 

2112 

2114 

2116 


Fls$  (I)  = Bd  $ (Choose(D)l  1 ; 1 4] 

End_search  = 1 

ELSE  I it  must  be  a Directory  or  message. 

SELECT  Bd$(Choose(l))[1 8,22] 

CASE  "up  ON"  ! move  up  one  directory 
LOOP 

Ms_path$  = Ms_path$[1  ,LEN(Ms_path$)-1] 
EXIT  IF  LEN(Ms_path$)  =0 

Test$  = Ms_path$[LEN(Ms  path$);1] 

EXIT  IFTest$  = ’/" 

END  LOOP 

CASE  "ROOT  * I jump  to  root  directory 
Ms_path$  = "" 

CASE  "DIR  " ! add  directory  to  Ms_path$ 

Test  $=  TRIM  $ (Bd  $ (Choosedm  1 , 1 41) 

Ms  path$  = Ms  path$&Test$&"/" 

case’else 

DISP  "ERROR  in  directory  jump" 

PAUSE 
END  SELECT 
I =C  cnt 
END  IF’ 

NEXT  I 
END  IF 
END  IF 
ELSE 

DISP  " This  directory  contains  no  ";Ftype$;"  files  ...  c 
WAIT  2.5 
End_search  = 1 
END  IF 

DISP  CHR$(1 2) 

UNTIL  End  search 
SUBEXIT 
Cat_errors:l 

DISP  " ERROR  ...  ";ERRM$ 

BEEP 

CALL  Pause_key_pn 
DISP  CHR$(1 2) 

C_cnt=0 
MAT  Fls$  = ("") 

SUBEXIT 

! 

! //////////////////////////////////////////////////// 

! 

Read_data_id:  ! This  routine  expects  to  see  lds$  from 
T GRAPH_DATA  raw  data  files. 

DISP  " Reading  file  contents  ...  Please  stand  by.  " 

PRINT  TABXY(1 ,1 8);"  Reading 
FOR  I = 1 TO  Bd_cnt  I each  BDAT  file 
PRINT  TABXYd  1,18); 

PRINT  USING  "3D,4A,3D,2Af#";l,"  of  ",Bd_cnt,\  " 
lds$  = "Data  not  recognized." 

IF  Bd$(l)[1 8f22]  = "BDAT  " THEN 
ON  ERROR  GOTO  Not_recognized 
ASSIGN  @lo_path  TO  Bd$(l)[1;141 
ENTER  @lo_path;Stat$ 
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2118  SELECT  Stat$ 

2120  CASE  "N" 

2122  ENTER  @lo_path;lds$ 

2124  CASE  "Y" 

2126  Ids  $ = " Complete  graph  in  GRAPHDATA  form." 

2128  END  SELECT 

2130  Not_recognized:  ASSIGN  @lo_path  TO  * 

2132  OFF  ERROR 

2134  IF  Dir_pn  = 2 THEN 

2136  GOSUB  Interpret^ 

2138  IF  Formatjsrror  THEN  GOTO  Other  format 

2140  GOTO  Gojan 

2142  END  IF 

2144  Other  format:! 

2146  Bd$(IH23,71] ...  "&lds$ 

2148  END  IF 

2150  Go_on:NEXT  I 

2152  PRINT  TABXY(1 ,1 8);RPT$("  ”,40); 

2154  DSSP  CHR$(1 2); 

2156  RETURN 

2158  ! 

2160  ! /////////////////////////////////////////////////// 

2162  \ 

2164  Interpret^:  S This  is  used  to  interpret  ID  strings, 

2 1 66  Format_error  - 1 

2168  I identify  this  particular  format 

2170  RETURN 

2172  I 

2174  ! /////////////////////////////////////////////////// 

2176  ! 

2178  List_directory:  ! This  routine  will  provide  a tabular  listing  of 
2180  ! the  directory  along  with  lds$  if  provided 

2182  I 

2184  DISP  " Listing  directory  ...  " 

2186  ON  TIMEOUT  7,10  GOTO  Printer  Jcaput 

2188  PRINTER  IS  Printer 

2190  PRINT  USING  ”//" 

2192  PRINT  T $ 

2194  IF  lEN(Ms_path$)>0  THEN  PRINT  "HFS  Path:  B;Ms_path$ 

2196  PRINT  RPT$(" -cs80) 

2198  PRINT  “File  name”; 

2200  IF  Dirjan  THEN 

2202  PRINT  " - TYPE  ...  contents” 

2204  ELSE 

2206  PRINT  " - TYPE" 

2208  END  IF 

2210  PRINT  RPT$r-"(80) 

2212  FOR  I = 1 TO  Bd_cnt 

2214  IF  Bd$(l)[1 8,22] -Ftype$  OR  Bd$(l)[1 8,22] -"DIR  "THEN 

2216  PRINT  Bd$(l) 

2218  END  IF 

2220  NEXT  I 

2222  PRINT  RPT$(”  B,80) 

2224  PRINT 

2226  PRINTER  IS  CRT 

2228  OFF  TIMEOUT  7 
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2230  RETURN 

2232  Printer  kaput:DISP  " Printer  not  responding  ...  listing  aborted.  " 

2234  BEEP 

2236  WAIT  1.8 

2238  OFF  TIMEOUT  7 

2240  RETURN 
2242  SUBEND 
2244  ! 

2246  I 

2248  ! 

2250  SUB  Menu_scroll(D$,T$,ltems$(*),INTEGER  ltem_cnt,To_select,Choose(*)) 
2252  Menu_scroll:l  Original:  22  Jun  1987,  Galen  Koepke,  NBS  723.04 
2254  I Revision:  22  Aug  1 990,  1 2:00,  Dennis  Camell 

2256  I 

2258  I A general  purpose  menu  utility  for  scrolling  items  and 

2260  I selecting  either  a fixed  number  or  a random  number 

2262  I of  items. 

2264  I for  fixed  : To^select  > 0 

2266  1 for  random  : fo_select  - -1 

2268  I The  items  are  arranged  in  screens  of  1 5 items  each  and 

2270  I the  user  may  access  screens  via  softkeys*  There  may  be 

2272  I up  to  40  screens  or  600  items  to  choose  from. 

2274  ! Maximum  sizes:  D$[801,  T$[51],  Items!*  )[701 

2276  I ltems$(*)  contains  the  item  descriptions 

2278  I ltem_cnt  is  the  number  of  items  in  items$(*l 

2280  I Choose! *)  is  dimensioned  to  the  number  of  required  choices 

2282  I and  will  be  filled  with  the  item  numbers  chosen. 

2284  ! To_select  is  the  number  of  required  choices. 

2286  I 

2288  OPTION  BASE  1 

2290  PRINTER  IS  CRT 

2292  DEG 

2294  GOSUB  Def_variables 

2296  GOSUB  Define_screens 

2298  GOSUB  Make_selections 

2300  IF  Null_file  THEN  I reset  to  zero 

2302  Itemcnt  - 0 

2304  ltems$(1)  = "" 

2306  To_select  = 0 I no  valid  selections 

2308  END  IF 

2310  SUBEXIT 

2312  ! 

2314  I //////////////////////////////////////////////////// 

2316  ! 

2318  Def_variables:l 

2320  COM  /Interrupts/  INTEGER  Intr  prty 

2322  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

2324  COM  /Sys/  Sys_id$[10] 

2326  ! 

2328  INTEGER  Screen_cnt,ltems_per_scn,FirstJtem(40),Lastjtem(40) 

2330  INTEGER  I, J,K, First Jine, Last_line,Active_screen, Pointer, Last_pt 

2332  INTEGER  Local_prty, Skips, Knobcount,Pointeractive,KO,Null_file 

2334  INTEGER  Exit  f lag, Temp, Random_seiect,lndx 

2336  DIM  Marker$(8],Test$[256] 

2338  I 

2340  I initialize  parameters 
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2342 

2344 

2346 

2348 

2350 

2352 

2354 

2356 

2358 

2360 

2362 

2364 

2366 

2368 

2370 

2372 

2374 

2376 

2378 

2380 

2382 

2384 

2386 

2388 

2390 

2392 

2394 

2396 

2398 

2400 

2402 

2404 

2406 

2408 

2410 

2412 

2414 

2416 

2418 

2420 

2422 

2424 

2426 

2428 

2430 

2432 

2434 

2436 

2438 

2440 

2442 

2444 

2446 

2448 

2450 

2452 


! 

Local_prty  = lntr_prty 

IF  Local_prty  <1  THEN  Local_prty  = 1 0 

IF  LEN(Sys_id$)  =0  THEN  Sysjd$  = SYSTEM $(" SYSTEM  ID") 

IF  item_cnt<  1 THEN 
Null_f  ile  = 1 
Itement  = 1 
To_select  = 0 

ltems$(1  ) = "***  Empty  ***" 

ELSE 

Nu!l_file  = 0 
END  IF 

IF  To_select  = -1  THEN 

Random_select  = 1 I choose  random  number  of  items 
To_select  = 0 ! needed  for  softkeys 

END  IF 

SF  To_se!ect>ltem_cnt  THEN  To_select  = ltem_cnt 
MAT  Choose  = (999) 

Skips -0 
Knobcount  = 0 
Donefiag-O 

Marker$  -n  = = = >"&RPT$(CHR$(8)S4) 

RETURN 

I 

I //////////////////////////////////////////////////// 

I 

Befine_screens:l  Set  up  screens  of  15  items  each. 

I 

!tems=per_scn  = 15  I Maximum  number  of  displayable  items 
IF  INT(ltem_cnt/ltemsj3er_scn)  = ltem_cnt/ltems_per_scn  THEN 
Screen_cnt  - INT{ltem_cnt/ltems_per_scn) 

ELSE 

Screen_cnt  - INTdtemcnt/ltemsperscn)  + 1 
END  IF 

J = 1 

FOR  I = 1 TO  Screen  cnt  ! set  up  each  screen 
Firstjtem(l)  =J 

IF  J + ltems_per_scn~1  <ltem_cnt  THEN 
Lastjtem(l)  -J  + Items  jaer_scn-1 
J = J + ltems_per_scn 
ELSE 

Lastjtem(l)  = Itemcnt 
END  IF 
NEXT  S 
RETURN 

S 

I /////////////////////////////////////////////////// 

I 

Make=selections:l  MENU  setup  and  use. 

Active^screen  = 1 ! first  screen  is  active 

First Jine  = 2 I first  printed  line  on  screen  = 2 or  greater. 

GOSUB  Write_screen  ! activate  screen  at  Active_screen 
! and  set  Firstjine  and  Lastjine  for  Pointer 
I write  Marker$  to  first  non-selected  line. 

K0  = 0 I Keys  start  at  zero 

Exit_flag  = 0 ! allow  ENTER  key  to  exit  when  selections  filled. 
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2454  Key  loop:  t 

2456  "ON  KBD,Local_prty  GOSUB  Process  Jcbd 
2458  ON  KNOB  .01,Local_prty  GOSUB  Move_pointer 

2460  IF  Random_select  THEN 

2462  I set  keys  for  random  selection 

2464  DISP  0$ 

2466  ON  KEY  KO  LABEL  " Select", Local_prty  GOSUB  Select_random 

2468  ON  KEY  KO  + 9 LABEL  " Accept",  Local_prty  GOTO  Exitjine 

2470  ELSE  ! set  key  KO  for  fixed  selection 
2472  IF  Skips  <To_select  THEN 

2474  DISP  D$  ‘ 

2476  IF  To_select>  1 THEN 

2478  Test$  = " Select  "&VAL$(Skips  + 1 )&"  of  "&VAL$(To_select) 

2480  ELSE 

2482  Test$  = " Select" 

2484  END  IF 

2486  ON  KEY  KO  LABEL  Test$,Local_prty  GOSUB  Select  fixed 

2488  ELSE 

2490  IF  To_select>0  THEN 

2492  DISP  " Selection  process  complete  ..." 

2494  ELSE 

2496  DISP  " Menu  for  information  only  ...  " 

2498  END  IF 

2500  ON  KEY  KO  LABEL  " Accept", Local_prty  GOTO  Exit  line 

2502  END  IF 

2504  END  IF 

2506  IF  Active_screen  < Screen_cnt  THEN 

2508  ON  KEY  KO+1  LABEL  " Next  Screen", Local  prty  GOSUB  Next_screen 

2510  ELSE 

2512  OFF  KEY  KO+1 

2514  END  IF 

2516  IF  Active_screen  > 1 THEN 

2518  ON  KEY  KO  + 2 LABEL  " Last  Screen", Local  prty  GOSUB  Last_sereen 

2520  ELSE 

2522  OFF  KEY  KO  + 2 

2524  END  IF 

2526  IF  Skips  >0  OR  Random  select  THEN 

2528  ON  KEY  KO  + 3 LABEL  " Reset  Select", Local_prty  GOSUB  Select_reset 

2530  ELSE 

2532  OFF  KEY  KO  + 3 

2534  END  IF 

2536  IF  To_select>0  OR  Random_select  THEN 

2538  ON  KEY  K0  + 4 LABEL  " Abort  ",Local_prty  GOTO  Escapejine 

2540  ELSE 

2542  OFF  KEY  KO  + 4 

2544  END  IF 

2546  IF  Screen_cnt>2  THEN 

2548  ON  KEY  KO  + 6 LABEL  "Jump  to  Screen",  Local  jjrty  GOSUB  Jump_to_scn 

2550  ELSE 

2552  OFF  KEY  KO  + 6 

2554  END  IF 

2556  IF  Exit_flag  THEN  Exitjine 

2558  GOTO  Keyjoop 

2560  EscapeJine:Skips  = 0 
2562  MAT  Choose  = (0) 

2564  To_select  = 0 
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2566  Exit_line:OFF  KEY 
2568  MAT  SORT  Chooser) 

2570  OFF  KNOB 

2572  OFF  KBD 

2574  OUTPUT  KBD;CHR$(255)&CHR$(75); 

2576  PRINT  CHR$(1 28); 

2578  I everything  cleared,  now  go  back  to  work. 

2580  RETURN 

2582  ! 

2584  ! /////////////////////////////////////////////////// 

2586  I 

2588  Next  screen:  I 

2590  OFF  KBD 

2592  OFF  KNOB 

2594  OFF  KEY 

2596  IF  Active_screen  = Screenjsnt  THEN  RETURN 

2598  Active_screen  = Activescreen  + 1 

2600  GOSUB  Write_screen 

2602  RETURN 

2604  ! 

2606  I /////////////////////////////////////////////////// 

2608  ! 

2610  last_sereen:  S 

2612  OFF  KBD 

2614  OFF  KNOB 

2616  OFF  KEY 

2618  IF  Active_screen  “ 1 THEN  RETURN 

2620  Active_screen  = Active_screen-1 

2622  GOSUB  Write  screen 

2624  RETURN 

2626  S 

2628  I ////////////////////////////////////////////////// 

2630  ! 

2632  Jump_to_errors:DISP  " Not  a valid  screen  number  ...  try  again.  “ 
2634  BEEP 

2636  WAIT  1.8 

2638  Jump_to_scn:  ! 

2640  OFF  KBD 

2642  OFF  KNOB 

2644  OFF  KEY 

2646  DSSP  " ENTER  the  screen  number  desired  (1  to  ";Screen  cnt;")." 
2648  UNPUT  Test$ 

2650  Test$  -TRIM$(Test$) 

2652  IF  LEN(Test$)  = 0 THEN  Jump_to_return 

2654  ON  ERROR  GOTO  Jump_to_errors 

2656  Temp  = INT(VAUTest$)) 

2658  OFF  ERROR 

2660  IF  Temp<1  OR  T emp > Screen_cnt  THEN  Jump_to_errors 

2662  Active_screen  - T emp 

2664  GOSUB  Write_screen 

2666  Jump_to_return:  I 

2668  DISPCHR$(12) 

2670  Test$  = BB 

2672  RETURN 

2674  I 

2676  I ////////////////////////////////////////////////// 


2678  ! 

2680  Select_fixed:! 

2682  OFF  KBD 

2684  OFF  KNOB 

2686  OFF  KEY 

2688  IF  NOT  Pointeractive  THEN 

2690  DISP  "NO  additional  selections  for  this  screen.” 

2692  BEEP 

2694  WAIT  2 

2696  DISP  CHR$(1 2); 

2698  RETURN 

2700  END  IF 

2702  IF  Skips = To  select  THEN 

2704  IF  To_select  = 0 THEN 

2706  DISP  "This  menu  is  for  information  only,"; 

2708  DISP  " no  selection  allowed." 

2710  ELSE 

2712  DISP  "All  selections  have  been  filled,"; 

2714  DISP  " 'Select  Reset'  to  repeat." 

2716  END  IF 

2718  BEEP 

2720  WAIT  2 

2722  DISP  CHR$(12); 

2724  RETURN 

2726  END  IF 

2728  Skips  = Skips  + 1 

2730  Choose(Skips)  = First  item(Active  screen)  + Pointer-First  line 

2732  PRINT  CHR$(  129);  T inverse  video 

2734  PRINT  TABXY(10,Pointer);ltems$(Choose(Skips)) 

2736  PRINT  CHR${1 28); 

2738  PRINT  TABXY(1, Pointer); 

2740  SELECT  Pointer 

2742  CASE  First Jine 

2744  GOSUB  Pointjorward 

2746  CASE  Lastjine 

2748  GOSUB  Point_backward 

2750  CASE  ELSE 

2752  ! move  forward  unless  it  requires  wrapping  to  beginning. 

2754  IF  Skips-1  >0  THEN  ! check  for  selected  items. 

2756  I = Pointer-First  line 

2758  LOOP 

2760  K = 0 

2762  FOR  J =*  1 TO  Skips 

2764  IF  First Jtem(Active=screen)  + 1 = Choose(J)  THENK  = 1 

2766  NEXT  J 

2768  EXIT  IF  K = 0 

2770  1=1+1 

2772  IF  I + First_line> Lastjine  THEN  K = -1 

2774  EXIT  IF  K =-1 

2776  END  LOOP 

2778  IF  K = 0 THEN 

2780  GOSUB  Point_forward 

2782  ELSE 

2784  GOSUB  Point Jiackward 

2786  END  IF 

2788  ELSE 
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2790  GOSUB  Point_forward 

2792  END  IF 

2794  END  SELECT 

2796  RETURN 

2798  I 

2800  ! ////////////////////////////////////////////////// 

2802  ! 

2804  Select_random:l 
2806  OFF  KBD 

2808  OFF  KNOB 

2810  OFF  KEY 

2812  Test$  = "NO" 

2814  IF  NOT  Pointeractive  THEN 

2816  DISP  "NO  additional  selections  for  this  screen." 

2818  BEEP 

2820  WAIT  2 

2822  DISP  CHR$(1 2); 

2824  RETURN 

2826  END  IF 

2828  FOR  8 - 1 TO  To  ^select 

2830  IF  Choose{l)-FirstJtem(Active=screen)  + Pointer-FirstJine  THEN 

2832  lndx  = l 

2834  Test$  — "YES” 

2836  END  IF 

2838  NEXT  I 

2840  SELECT  Test$ 

2842  CASE  "YES"  I Selected  item  is  tagged  ...  untag 

2844  IF  Pointer  <>  Last  jtem  (Active  screen)  + 1 AND  Pointer  < > 17  THEN 

2846  PRINT  CHR$(1 28);!  normafvideo 

2848  ELSE 

2850  PRINT  CHR$(1 32);!  underline  video 

2852  END  IF 

2854  PRINT  TABXYd  0,Pointer);ltems$(Choose(lndx)) 

2856  FOR  I -Indx  TO  To_select-1 

2858  Choose(l)  = Choosed  + 1 ) 

2860  NEXT  I 

2862  Choose(T  o_select)  = 999 

2864  To_select  = To_select-1 

2866  CASE  "NO"  I Selected  item  is  untagged  ...  tag  it 

2868  To_select=To_select+ 1 

2870  Choose(To_select)  = First  Jtem  (Active^screen)  + Pointer-Firstjine 

2872  IF  Pointer  < >Last_item(Active_screen)  + 1 AND  Pointer  < >17  THEN 

2874  PRINT  CHR$(129);!  inverse  video 

2876  ELSE 

2878  PRINT  CHR$(133);!  inverse  video  with  underline 

2880  END  IF 

2882  PRINT  TABXYd  0,Pointer);ltems$(Choose(To_select)) 

2884  END  SELECT 

2886  PRINT  CHR$(1 28); 

2888  PRINT  TABXYd  ^Pointer); 

2890  RETURN 

2892  I 

2894  ! ////////////////////////////////////////////////// 

2896  ! 

2898  Select_reset:  (Clear  Choose  file 

2900  OFF  KBD 
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2902  OFF  KNOB 

2904  OFF  KEY 

2906  IF  Random_select  THEN  To_select  = 0 

2908  Skips  = 0 

2910  MAT  Choose  = (999) 

2912  GOSUB  Write_screen 

2914  RETURN 

2916  I 

2918  ! ///////////////////////////////////////////////// 

2920  I 

2922  Process  kbd:l  Allow  use  of  arrows  and  enter  key  in  addition  to  soft. 
2924  Test$  =KBD$ 

2926  IF  LEN(Test$)  = 1 AND  Test$(1,1]<  >CHR$(32)  THEN 
2928  BEEP  80.,.1 

2930  RETURN 

2932  END  IF 

2934  IF  Test$[1 ,1]  = CHR${32)  THEN  GOSUB  Point  forward 
2936  IF  Test$HJ]<  >CHR$(255)  THEN  RETURN 

2938  SELECT  Test$[2,2] 

2940  CASE  CHR$(255) 

2942  ! do  nothing 

2944  CASE  "WT" 

2946  GOSUB  Point_forward 

2948  CASE  "A\"W" 

2950  GOSUB  Point_backward 

2952  CASE  "E\"s\"t\"&" 

2954  IF  Random_select  THEN 

2956  GOSUB  Select_random 

2958  ELSE 

2960  IF  Skips  < To  select  THEN 

2962  GOSUB  Select_fixed 

2964  ELSE 

2966  ! exit  routine 

2968  Exit_flag  - 1 

2970  END  IF 

2972  END  IF 

2974  CASE  ELSE 

2976  BEEP  80.,. 1 

2978  END  SELECT 

2980  Test$  = 

2982  RETURN 

2984  ! 

2986  ! ////////////////////////////////////////////////// 

2988  I 

2990  Point_forward:Knobcount  - h 
2992  GOSUB  Move_pointer 

2994  RETURN 

2996  Point_backward:Knobcount  = -5 
2998  GOSUB  Move_pointer 

3000-  RETURN 

3002  ! 

3004  ! ////////////////////////////////////////////////// 

3006  ! 

3008  Jog_pointer:!  Move  the  selection  pointer  on  the  active  screen. 

3010  ! without  regard  to  selected  values 

3012  IF  Knobcount>0  THEN  ! Move  forward 
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3014  Pointer  = Pointer  + 1 

3016  ELSE  I Move  backward 

3018  Pointers  Pointer-1 

3020  END  IP 

3022  IF  Pointer  < First Jine  THEN  Pointer  = Last Jine 

3024  IF  Pointer  > Last Jine  THEN  Pointer  = First  Jine 

3026  RETURN 

3028  I 

3030  I ///////////////////////////////////////////////////////// 

3032  I 

3034  Move_pointer:l  Control  pointer  to  avoid  re-selection  of  items 

3036  IF  NOT  Pointeractive  THEN  RETURN  I No  selections  to  be  made. 

3038  Knobcount  = Knobcount  + KNOBX-KNOBY 

3040  IF  ABS(Knobcount)  < 4 THEN  RETURN 

3042  Last_pt  = Pointer 

3044  GOSUB  Jog_pointer 

3046  IF  Skips  >0  THEN 

3048  LOOP 

3050  J = Pointer  First  line 

3052  FOR  1 = 1 TO  Skips 

3054  IF  First  item(Aetive=screen) + J sChoose(l)  THEN  J = 999 

3056  NEXT  I 

3058  IF  J^999  AND  Pointer  = Last^pt  THEN  Pointeractive  = 0 

3060  EXIT  IF  Pointeractive  s 0 

3062  IF  J * 999  THEN  GOSUB  Jog  ^pointer 

3064  EXIT  IF  J<  >999 

3066  END  LOOP 

3068  END  IF 

3070  Knobcount  = 0 

3072  OUTPUT  KBD;CHR$(255)&CHR$(84);  I Bring  screen  home 

3074  IF  last_pt  = Last  line  THEN  PRINT  CHR$(132); 

3076  PRINT  ’ 

3078  IF  Pointeractive  THEN  I Pointer  active 

3080  IF  Pointer  = Last  Jine  THEN 

3082  PRINT  CHR$«1 32); 

3084  ELSE 

3086  PRINT  CHR$(1 28); 

3088  END  IF 

3090  PRINT  TABXYO  sPointer);Marker$;CHR$(1 28); 

3092  END  IF 

3094  RETURN 

3096  I 

3098  ! ////////////////////////////////////////////////// 

3100  l 

3102  Write^screen:!  Write  the  screen  pointed  to  by  Active_screen 
3104  I home  and  clear  screen 

3106  OUTPUT  KBD;CHR$(255)&CHR$(84)&CHR$(255)&CHR$(75); 

3108  Knobcount  = KNOBX-KNOBY  S Clear  knob  and  keyboard 

3110  Knobcount  = 0 

3112  Test$  sKBD$ 

3114  Test$ 

3116  I 

3118  PRINT  TABXYd  .First  line-1  );CHR$(1 32);"  Item  M\  Screen 

3120  PRINT  USING  "#,2De4A,2Df3A";Activej5creen,w  of  ";Screen_cnt;"  | 

3122  PRINT  T$;RPT$r  ".51  -LEN(T$)); 

3124  PRINT  TABXY(80,FirstJine-1 );"  | ";CHR$(1 28); 
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3126 

3128 

3130 

3132 

3134 

3136 

3138 

3140 

3142 

3144 

3146 

3148 

3150 

3152 

3154 

3156 

3158 

3160 

3162 

3164 

3166 

3168 

3170 

3172 

3174 

3176 

3178 

3180 

3182 

3184 

3186 

3188 

3190 

3192 

3194 

3196 

3198 

3200 

3202 

3204 

3206 

3208 

3210 

3212 

3214 

3216 

3218 

3220 

3222 

3224 

3226 

3228 

3230 

3232 

3234 

3236 


J = 0 
REPEAT 

IF  J = Last_item(Active_screen)-First  item(Active_screen)  THEN 
PRINT  CHR$(1 32); 

PRINT  TABXYd  .First Jine + J);RPT$("  *,80) 

ELSE 

PRINT  CHR$(128); 

END  IF 

PRINT  TABXY(5,First_line  + J); 

PRINT  USING  "3D,A,#";FirstJtem(Active_screen)+J,"|" 

IF  Random_select  THEN 
FOR  1=1  TO  To_select 

IF  First  item(Active_screen)  + J = Choose(l)  THEN 
PRINT  CHR$(1 29); 

END  IF 
NEXT  I 
ELSE 

IF  Skips  >0  THEN  I make  this  line  inverse  video 
FOR  I = 1 TO  Skips 

IF  First Jtem (Active  screen) +J  = Choose(l)  THEN 
PRINT  CHR$(1 29); 

END  IF 
NEXT  I 
END  IF 
END  IF 

PRINT  TABXYd  0, First  line  + J);ltems$(FirstJtem(Active_screen)  + J) 
PRINT  TABXY(80, First Jine  + J);"  |"; 

J=J  + 1 

UNTIL  J>  = (LastJtem(Active_screen)-FirstJtem(Active_screen)  + 1) 
Lastjine  = LastJtem(Active_screen)-FirstJtem(Active_screen) 

Last  line  = Last  line  + Firstjine 
1 

I set  marker  to  first  non-selected  item. 

I 

Pointeractive  = 0 

IF  To_select>0  OR  Random_select  THEN  Pointeractive  = 1 
IF  Skips  >0  AND  Pointeractive  = 1 THEN  1 find  first  non-selected  item 
J=0 
LOOP 

Pointer  = Firstjine  + J 
FOR  1 = 1 TO  Skips 

IF  First  Jtem(Active_screen) +J  =Choose(l)  THEN  Pointer  = 0 
NEXT  I 

EXIT  IF  Pointer  < >0 
J=J  + 1 

IF  Firstjine + J>LastJine  THEN 
Pointeractive  = 0 
Pointer  = Firstjine 
END  IF 

EXIT  IF  Pointer  < >0 
END  LOOP 
ELSE 

Pointer  = Firstjine 
END  IF 

IF  Pointeractive  THEN 

IF  Pointer  = Lastjine  THEN 
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3238  PRINT  CHR$(1 32); 

3240  ELSE 

3242  PRINT  CHR$(1 28); 

3244  END  IF 

3246  PRINT  TABXYO  ,Pointer);Marker$;CHR$0  28); 

3248  END  IF 

3250  RETURN 

3252  SUBEND 
3254  ! 

3256  ! ® * * * # * * # • ® * * * * * * * * * * * « « * * # * # * * « • « » o » « » # ® » * « e c e o » « « * * # «• e « 

3258  I 

3260  SUB  Pause_key_on 

3262  PauseJcey_on:  1 Make  sure  that  CONTINUE  key  exists. 

3264  ! Original:  02  Dec  1987 

3266  \ Revision:  02  Dec  1 987 

3268  OPTION  BASE  1 

3270  COM  /Sys/  Sys_id$[10] 

3272  IF  Sysjd$[1 ,4]  = "S300"  THEN  I reset  to  S300  system  keys 
3274  CONTROL  K8D,15;0 

3276  CONTROL  CRT,  12;2 

3278  LOAD  KEY 


3284  IF  Sys  id$[1 ,4]  = "S30Q"  THEN 

3286  OUTPUT  KBD  USING  "K,#";’ 

3288  CONTROL  KBD,  15;1 

3290  CONTROL  CRT,  1 2;0 

3292  END  IF 
3294  SUBEXIT 
3296  SUBEND 
3298  ! 

3300 
3302 
3304 


I set  to  S200  compatible  keys 
SCRATCH  KEYX" 


SUB  Errortrap 


3306  Errortrap:  I Original:  1 3 Nov  1 984 
3308  I Revision:  02  Dec  1 987 


3310  ! Trap  most  errors  here 

3312  OPTION  BASE  1 

3314  COM  /Files/  Diskdrive$l20]5Filename${14]JMs_path$[500S 

3316  DIM  File$[20JJest$[256],What$[20j,Ac$[5] 

3318  BEEP  400,. 6 

3320  SELECT  ERRN 

3322  CASE  54 

3324  DISP  "DUPLICATE  FILE  NAME:  ";Filename$; 

3326  DISP  "....PURGE  old  one?  (Y/N)"; 

3328  LINPUT  What$ 

3330  What$  =TRIM$(What$) 

3332  SELECT  What$l  1,1] 

3334  CASE  "Y\"y" 

3336  PURGE  Ms_path$&Fiiename$&Diskdrive$ 

3338  CASE  ELSE 

3340  Ac$  = "VALID" 

3342  CALL  Enterfilename(Ac$) 

3344  END  SELECT 

3346  CASE  52,53 

3348  DISP  "Improper  FILE  NAME  - ENTER  NEW  FILE  NAME"; 
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OUTPUT  2 USING  "#,K,K";"#";FiIename$ 

LINPUT  Filename  $ 

Filename$  =TRIM$(Filename$) 

CASE  56 

DISP  "FILE:  ";Filename$;"  is  not  on  this  disk,  please  insert"; 
DISP  " correct  disk" 

CALL  Pause  key_on 
CASE  64 

DISP  "This  disk  is  full,  PLEASE  insert  clean  disk" 

CALL  Pause  key  on 
CASE  56 

DISP  "DATA  INPUT  disk  must  be  in  drivel!  "; 

DISP  "...CONTINUE  when  ready." 

CALL  Pause  key  on 
CASE  72,73,76 
DISP  Diskdrive $; 

DISP  " is  not  available,  type  correct"; 

DISP  " unit  specifier  (ie.  ':, 707,0')."; 

OUTPUT  2 USING  "K,#";Diskdrive$ 

LINPUT  Diskdrive$ 

CASE  80 

DISP  "CHECK  DISK  drive  door!" 

CALL  Pause_key_on 
CASE  ELSE 

DISP  ERRM$;"  'CONTINUE'  when  fixed" 

CALL  Pause_key_on 
END  SELECT 
DISP  CHR${1 2) 

SUBEXIT 
3408  SUBEND 
3410  ! 

3412  ! 

3414  ! 

3416  SUB  Auto_format(Value) 

3418  Auto_format:  ! Original:  13  Nov  1984 

3420  ! Revision:  30  Aug  1990 

3422  ! Select  the  proper  number  of  digits  to  display. 

3424  ! This  routine  is  used  by  several  program  sections  to 

3426  ! print  numbers  to  the  display. 

3428  ! 

3430  SELECT  ABS(Value)  • 

3432  CA$E>  = 1.0E  + 5 

3434  SELECT  ABS(Value) 

3436  CASE  <1.0E+10 

3438  PRINT  USING  "#,MD.4DESZ,2X";Value 

3440  CASE  < 1 .0E+  100 

3442  PRINT  USING  "#,MD.4DESZZ,X";Value 

3444  CASE  ELSE 

3446  PRINT  USING  "#,MD.4DESZZZ";Value 

3448  END  SELECT 

3450  CASE  >=1.0 

3452  IF  Value  = PR0UND(Value,-4)  THEN 

3454  IF  INT(Value)  = Value  THEN 

3456  PRINT  USING  "#,M5D,6X";Value 

3458  ELSE 

3460  PRINT  USING  "#,M5D.4D,X";Value 


3350 

3352 

3354 

3356 

3358 

3360 

3362 

3364 

3366 

3368 

3370 

3372 

3374 

3376 

3378 

3380 

3382 

3384 

3386 

3388 

3390 

3392 

3394 

3396 

3398 

3400 

3402 

3404 

3406 


3229 


3462 

3464 

3466 

3468 

3470 

3472 

3474 

3476 

3478 

3480 

3482 

3484 

3486 

3488 

3490 

3492 

3494 

3496 

3498 

3500 

3502 

3504 

3506 

3508 

3510 

3512 

3514 

3516 

3518 


END  IF 
ELSE 

PRINT  USING  "#,MD.4DESZP2X";  Value 
END  IF 


I + + + + + + All  values  less  that  1.0  + + + + + + + + + + 
I 

CASE  > = 1 .0E-4 

IF  PR0UND(Valuef-41  = Value  THEN 
PRINT  USING  " #,4X,MZ.4DfX";Value 
ELSE 

PRINT  USING  "#,MD.4DESZ,2X";Value 
END  IF 

I 

CASE  > * 1 .OE-9 

PRINT  USING  "#,MD.4DESZ,2X";Value 
CASE  > = 1 .0E-99 

PRINT  USING  8#,MD.4DESZZ»X";Value 
CASE  > 1 .0E-300 

PRINT  USING  "#,MD.3DESZZZ,X";Value 
CASE  ELSE 

PRINT  USING  °#f4X,MZ.0s4Xw;Value 
END  SELECT 
SUBEXIT 
SUBEND 
! 
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B.8  text  out 


100  ! RE-STORE  "text_out:,1400" 

102  ! 

104  COM  /Sys/  Sys_id$[10] 

106  COM  /Sys  msi/  Msi_id$[20] 

108  ! 

110  ! * 

112  ! This  program  reads  in  an  ASCII  file  and  produces  a hard  copy. 

114  lit  ain't  much,  but  it  is  useful. 

116  I The  subroutines  are  modified  versions  of  the  GRAPH_DATA  subs 
118  I of  the  same  names. 

120  I Created  at  NIST;  built  by  S.M.  Chesnut. 

122  ! 

124  I 

1 26  Datejine:  I 

128  I 

130  1 April  26,1991 

132  I 

134  I 

136  OUTPUT  KBD  USING  "K,#";"  SCRATCH  KEYE"  I ERASE  SOFT  KEYS 

138  CONTROL  KBD,15;0!  sets  the  color  of  the  soft  keys 
140  CONTROL  KBD, 2;  1 
142  I 

1 44  lntr_prty  = 1 
1 46  CALL  Read_data 
1 48  ! 

1 50  PRINTER  IS  CRT 

152  OUTPUT  KBD  USING  "K,#";"LOAD  KEYE"!  restore  the  typing  aid  keys 
1 54  CLEAR  SCREEN 

156  PRINT  TABXYd  ,5);"END  of  program.  So  long." 

158  MASS  STORAGE  IS  1400" 

160  I 
162  END 
164  ! 

166  l_ 

168  ! 

170  ! 

172  SUB  Load_diskjJata(Basket_file(#), INTEGER  Basketsize,Datajd$, INTEGER  Fig) 

174  Load_disk_data:  ! Original;  13  Nov  1984 

176  I Revision:  02  Dec  1987 

178  IThis  routine  will  enter  data  files  from  the  disk 

180  OPTION  BASE  1 

182  ! 

184  COM /Sys/ Sys_id$ 

186  COM  /History/  Status$[1],Time_orgn$[8],Date_orgn$[1 1] 

188  COM /History/ Time  chng$[8],Date_chng$[1 1],Description$[1 60] 

190! 

192  COM  /Labels/  Labels$(30)[60], INTEGER  Lbl_count,REAL  Lbl_addr(30,6) 

1 94  !Lbl_addr:  x,  y,  pen,  size,  LDIR,  LORG 
196  ! 

198  COM  /Data_param/  INTEGER  Datacount,Fi!esize,Curvecount,Roster(1 7,4) 

200  COM  /Data_param/  REAL  Sym_size,Symbol$(1 7)[2],Curvejd$(1 7)[40] 

202  COM  /Data_param/  REAL  Xmin_data,Xmax_data 

204  COM  /Data  param/  REAL  Ymin_data,Ymax_data 

206  ! 

208  IRoster:  Curve#,  Start  Addr  in  File!*),  Datacount,  and  PEN 
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210  !SymboI$(i)  = ""  or  "Y"  = > no  symbol,  connect  pts 
212  !Symboi$(i)  = "#Y"  =>  * symbol,  connect  pts 
214  !Symbol$(i)  = "#N"  = > # symbol,  do  not  connect  pts 

216  I 

218  COM  /Background/  Graphtype$[12],Margins$(2)[10],Papersize$[1] 

220  COM  /Background/  REAL  Penspeed, INTEGER  Backgnd_pen,Auto_time 

222  COM  /Background/  INTEGER  Auto_file,REAL  X_cross_y,Y_cross_x 

224  COM  /Background/  Xgrid_tick$  [4], INTEGER  Xmajor,Xminor 

226  COM  /Background/  Ygrid_tick$[4], INTEGER  Ymajor,Yminor 

228  COM  /Background/  REAL  Xmin_graph,Xmax_graph,Ymin_graph,Ymax_gfaph 

230  l 

232  COM  /Bugs/  INTEGER  Bug1,Bug2,Bug3,Printer 

234  COM  /Interrupts/  INTEGER  lntr_prty 

236  COM  /Enlargejile/  INTEGER  Overflow 

238  COM  /Files/  Diskdrive${20],Fiiename$I141,Msj)ath$[500] 

240  COM  /Data  stuff/  INTEGER  Number, REAL  Delta_x,REAL  Strt  time 
242  ! 

244  INTEGER  R.Hold  size,Local_prty, Allocated, FIs  cnt 

246  DIM  Ac$|5LTem”pfile$n0],Mask$[10],Ftype$T5]«Fls$nH10] 

248  REAL  Dtime 

250  OFF  KEY 

252  Local  jsrty  = Intrprty 

254  I 

256  SSelect  the  disk  drive  where  the  data  exists 

258  I 

260  IF  Overflow  < > 0 THEN  Overflow  = 0 

262  Hold ^ size -0 

264  Dtime  -0. 

266  Allocated  = 0 

268  Selectdrive:  ! 

270  IF  Diskdrive$  = "NO  DISK"  THEN  Diskdrive$  = 

272  IF  LEN(Diskdrive$)>0  THEN  GOTO  Choosefilename 

274  GRAPHICS  OFF 

276  OUTPUT  2 USING  "#,K";"K" 

278  CALL  Select jiisk 

280  IF  Diskdrive$  = "NO  DISK"  THEN  GOTO  Mistakelineset 

282  Choosefilename:  I 

284  Tempfile$  = Filename$ 

286  IF  LEN(Filename$)>0  THEN  GOTO  Bring  in  data 

288  Ac$  ~ "CAT" 

290  CALL  Enterfilename(Ac$) 

292  IF  LEN(Filename$)  =0  OR  POS(Filename$,"#")>  1 THEN 

294  IF  POS(Filename$,"#")>  1 THEN  ! set  mask$ 

296  Mask$=Filename$[1,POS(Filename$,"#")-1] 

298  Filename$  = "" 

300  ELSE 

302  Mask$  = ""!  no  preselection 

304  END  IF 

306  Ftype$  = " ASCII"  I examine  ASCII  files  only 

308  Fls_cnt=1  I select  one  file 

310  lntr_prty  = Local_prty  + 1 

312  CALL  File_menu(Mask$,Ftype$,Fls$(*),Fls_cnt,0,OI 

314  intr__prty  - LocaSprty 

316  Filename$  =Fls$(1) 

318  IF  LEN(Filename$|  = 0 THEN  ! aborted 

320  Filename$  =Tempfile$ 

322  GOTO  Mistakelineset 

324  END  IF 
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326  END  IF 

328  Bring  in  data:  I 
330  T ” 

332  IFind  this  file  on  the  disk. 

334  ! 

336  ON  ERROR  GOTO  Cantjindfile 

338  ASSIGN  @Datapath  TO  Filename$&Diskdrive$ 

340  OFF  ERROR 

342  Dtime =TIMEDATE 

344  DISP  " LOADING  disk  file:  ";Filename$;"  ...  "; 

346  ON  ERROR  GOTO  Badjile 

348  ENTER  @Datapath;Status$ 

350  OFF  ERROR 

352  ON  ERROR  GOTO  Cant  findfile 

354  SELECT  Status  $ 

356  CASE  "Y"  ! All  graphics/data  parameters  exist.REN  100,2 

358  DISP  * Complete  graph.  " 

360  ENTER  @Datapath;Time_orgn$,Date_orgn$ 

362  ENTER  @Datapath;Time_chng$,Date_chng$ 

364  ENTER  @Datapath;Description$ 

366  ENTER  @Datapath;Labels$(#),Lbl_count,LbLaddr(#) 

368  ENTER  @Datapath;CurveJd$(*),Symbol$(#7 

370  ENTER  @Datapath;Roster(*),Curvecount 

372  ENTER  @Datapath;Graphtype$,Margins$(*) 

374  ENTER  @Datapath;X_cross_y,Y_cross_x 

376  ENTER  @Datapath;XgridJick$,Xmajor,Xminor 

378  ENTER  @Datapath;YgridJick$,Ymajor,Yminor 

380  ENTER  @Datapath;Xmin_graph,Xmax_graph 

382  ENTER  @Datapath;Ymin_graph,Ymax_graph 

384  CASE  "N"  I Only  data  parameters  exist. 

386  DISP  ’ RAW  data.  " 

388  CASE  ELSE 

390  Badjile:  DISPCHR$(12) 

392  DISP  "Data  file  is  not  recognized,  entry  aborted."; 

394  DISP  " ...continue." 

396  BEEP 

398  PAUSE 

400  OFF  ERROR 

402  GOTO  Mistakelineset 

404  END  SELECT 

406  ! 

408  ENTER  @Datapath;Data  id$ 

410  IF  Fig  THEN 

412  ENTER  @Datapath;Deltajc 

414  ENTER  @Datapath;Datacount 

416  Hold  size  = Datacount 

418  ELSE 

420  ENTER  @Datapath;Datacount 

422  ENTER  @Datapath;Hold_size 

424  END  IF 

426  IF  NOT  Allocated  THEN 

428  IF  Datacount>  = 1 AND  Hold  _size>  = 1 THEN 

430  ALLOCATE  HoldingJile(Hold_size,2) 

432  ELSE 

434  ALLOCATE  Holding Jile(  1,2) 

436  END  IF 
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438  Allocated  = 1 

440  END  IF 

442  ENTER  @Datapath;Holding_file(#) 

444  ASSIGN  @Datapath  TO  * “ 

446  OFF  ERROR 

448  IF  NOT  Fig  THEN 

450  Delta_x  = Holding_f  ile(2,  1 )-Holding_f  i!e{  1,1) 

452  Strt_time  = Holding  filed , 1 ) 

454  END  IF 

456  IF  Datacount  = 0 THEN  Mistakeline 

458  I 

460  ICopy  data  from  Holding  filed)  to  Basket_f  iled ) 

462  ! 

464  MAT  Basket Jile=  (0.) 

466  IF  Datacount>Basketsize  THEN  {Receiving  file  too  small. 

468  Allocated  = 0 

470  DEALLOCATE  Holding  Jiled) 

472  DISP  " DATA  FILE  overflow,  new  data  discarded. 

474  DISP  * (continue)  " 

476  BEEP 

478  PAUSE 

480  IF  Status  $ - “Y*  THEN 

482  Curveeount-0 

484  MAT  Roster  - (0) 

486  END  IF 

488  Overflow -Holdsize 

490  GOTO  Mistakelineset 

492  END  IF 

494  Copydatafile:  I 

496  FOR  R = 1 TO  Datacount 

498  Basket  file(R,  1 ) = Holding _f ile(R.  1 ) 

500  Basket :“file(R,2)  = Holding  _file(R,2) 

502  NEXT  R 

504  Basketsize  --  Datacount 

506  GOTO  Mistakeline 

508  ! 

510  Mistakelineset:Datacount-0 
512  Mistakeline:OFF  KEY 

514  IF  Allocated  THEN  DEALLOCATE  Holding _file( e ) 

516  LOOP 

5 1 8 EXIT  IF  TIMEDATE-Dtime  > 1 .8 

520  END  LOOP 

522  DISP  CHR$(1 2) 

524  OUTPUT  2 USING 

526  SUBEXIT 

528  I 

530  ! //////////////////////////////////////////////////////// 

532  ! 

534  Cant_findfile:  I Error  in  searching  for  the  filec 

536  BEEP  500f.6 

538  SELECT  ERRN 

540  CASE  56 

542  DISP  "That  file  does  not  exist  on  this  disk  B; 

544  CASE  72,73,76,82 

546  DISP  Diskdrive$;B  has  failed  or  is  not  available  B; 

548  CASE  ELSE 
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550  DISP  ERRM$; 

552  END  SELECT 

554  DISP  " ....CONTINUE  to  try  again." 

556  PAUSE 

558  Filename$  = "" 

560  Diskdrive$  = "" 

562  GOTO  Selectdrive 

564  I 

566  SUBEND 
568  I 

570  ! 

572  ! 

574  SUB  Select_disk 

576  Select_disk:  l Original:  04  Jul  1987 

578  1 Revision:  06  Aug  1987 

580  COM  /Files/  Diskdrive$l201,Filename$l14],Ms_path$[500J 

582  COM  /Interrupts/  INTEGER  lntr_prty 

584  COM  /Sys_msi/  Msi_id$ 

586  COM  /Sys/  Sys_id$~ 

588  INTEGER  Local  prty, Dd,Pt, Choose!  1 ) 

590  DIM  Disc  $ <30)l60],Title$  [401,Displ  $ [60] 

592  Local  prty  = lntr  prty 

594  OFF  KEY 

596  ! 

598  I Define  the  disk  drives  available  for  this  system,  reserve  the 
600  I first  characters  for  the  drive  address  and  the  characters  after 

602  I the  - for  a description  of  the  drive. 

604  ! 

606  ! Example: 

608  ! Disc$(1 ) = ":,700,0,0  HP  9133H  HARD  disk,  volume  0." 

610  I 

612  ! 

614  Displ$  = " SELECT  DISK  DRIVE  ...  Abort  will  cancel.  " 

616  Title$  = " Available  disk  drives  for  this  system.  " 

618  Pt  = 1 ! allow  only  one  select 

620  ! 

622  IF  Diskdrive$(1,1]<  >":"  THEN  Diskdrive$  = "" 

624  IF  Msijd$[1,1]<  >":"  THEN  Msijd$  « SYSTEM $(" MSI") 

626  Diskdrive$  = TRIM  $ (Diskdrive  $) 

628  Msi_id$  =TRIM$(Msi_id$) 

630  IF  LEN(Diskdrive$) >0  AND  LEN(Msijd$)>0  THEN 

632  Disc  $ ( 1 ) = Diskdrive  $ &RPT  $ ("  ",17-LEN(Diskdrive$)) 

634  Disc$(1 ) = Dise$(1  )&"-  Last  selected  disk  drive." 

636  Dd  - 1 

638  IF  Diskdrive$  < >Msi_id$  THEN 

640  Disc$(2)  = MsiJd$&RPT$("  ",1 7-LEN(Msi_id$)) 

642  Disc$(2)  = Disc$(2)&"-  Start-up  mass  storage  unit  specifier." 

644  Dd  = Dd  + 1 

646  ELSE 

648  Disc$(1 ) = Disc$(1  )&"  Start-up  MSUS." 

650  END  IF 

652  ELSE 

654  IF  LEN(MsiJd$)>0  THEN 

656  Disc  $ ( 1 7=  Msi_id$&RPT$r  ",1 7-LEN(MsiJd$)) 

658  Disc$(1)  = Disc$(1)&"-  Start-up  mass  storage  unit  specifier." 

660  Dd  = 1 
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662 

664 

666 

668 


ELSE 
Dd  = 0 
END  IF 
END  IF 


670  Disk:  I 


672 

674 

676 

678 

680 

682 

684 

686 

688 

690 

692 

694 

696 

698 

700 

702 

704 

706 

708 

710 

712 

714 

716 

718 

720 

722 

724 

726 

728 

730 

732 

734 

736 


\ customize  system  drives  here  .................. 

! Follow  format  with  - after  unit  specifier,  description  is 
I optional  but  recommended. 


- HP  9122  dual  microfloppy  left  drive" 

- HP  9122  dual  microfloppy  right  drive' 

- HP  9125  single  5.25  floppy  drive" 

- HP  7957B  HARD  DISK  HFS  FILE" 


Disc$(Dd  + 1)  = ":,7Q2,0 
Disc$(Dd  + 2)  = 702,1 

Disc$(Dd  + 3}  = 703,0 

Disc$(Dd  + 4|  = ":,1 400 
\ 

Dd  * Dd  + 4 S add  the  number  of  drive  specifiers  above 

! 

IF  Sysjd$[1 ,4]  < > "S300"  THEN 

Dise$(Dd  + 1)  = ":,4,1  - LEFT  internal  series  200" 

Disc$(Dd  + 2)-":,4,0  - RIGHT  internal  series  200' 

Bd  - Dd  + 2 
END  IF 


CALL  Menu_scrol!(Dispi$,Title$,Disc$(*),Dd,Pt, ChooseD) 

IF  Pt~Q  THEN 

Diskdrive  $ “BNO  DISK" 

ELSE 

Dd  -POS(Dise$(Choose(Pt)),B=")-1  ! find  - 
IF  Dd>5  THEN  S valid  msus 

Diskdrive  $ ^ TRIM  $ (Disc  $(Choose«PtM1  ,Dd]) 

ELSE 

DISP  ” ERROR  in  reading  MSUS  from  string,  - chr  not  found.  B 
BEEP 
PAUSE 

Diskdrive  $ -BNO  DISK" 

END  IF 
END  IF 

738  Diskseiected:OFF  KEY 
740  SUBEXIT 

742  SUBEND 
744  I 

746  ! ***«**«**•««**«»«•«***««*•* .***•.****«>**«.  e * < 

748  ! 

750  SUB  Data_to_disk_/(REAL  File(#), INTEGER  Filesize,Datacount,Data_id$) 
752  Data_to_disk_r:  I Original:  13  Nov  1984 

754  ! Revision:  06  Aug  1987 

756  l This  routine  will  SAVE  data  files  on  the  disk  in  RAW  data  format. 
758  5 Special  features: 

760  ! If  the  Diskdrive  $ and/or  the  Filename  $ are  null  this  routine 

762  ! will  prompt  the  operator  for  information.  However,  if  they 

764  I are  not  null  it  is  assumed  that  the  program  is  supplying  the 

766  I correct  information. 

768  ! 

770  OPTION  BASE  1 

772  COM  /Files/  Diskdrive$l20],Filename$[14j,Ms_path$l500] 
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774  COM  /Interrupts/  INTEGER  lntr_prty 

776  INTEGER  Local_prty,  Diskspace 

778  DIM  Ac$[5],Status$[1] 

780  REAL  Dtime 

782  OFF  KEY 

7 84  Local  _prty  = Intr _prty 

786  Dtime  = 0. 

788  I 

790  (Select  the  disk  drive  for  data  storage 

792  ! 

794  Selectdrive:  I 

796  IF  Diskdrive  $ = "NO  DISK"  THEN  Diskdrive$  = "" 

798  IF  LEN(Diskdrive$)>0  THEN  GOTO  Choosefilename 

800  GRAPHICS  OFF 

802  OUTPUT  2 USING  "#,K";"K" 

804  CALL  Select.disk 

806  IF  Diskdrive$~="NO  DISK"  THEN  GOTO  Mistakeline 

808  Choosefilename:  I 

810  IF  LEN(Filename$)>0  THEN  GOTO  Send_to  disk 

812  Ac$  = "ABORT" 

814  CALL  Enterfilename(Ac$) 

816  IF  LEN(Filename$)  = 0 THEN  GOTO  Mistakeline 

818  Send_to_disk:  ! Create  file  and  save  information. 

820  ON  ERROR  GOTO  Cant  savedata 

822  Diskspace  = INT((Filesize  # 1 6.01/256)  + 2 

824  CREATE  ASCII  Filename$&Diskdrive$, Diskspace 

826  Dtime  = TIMED  ATE 

828  DISP  ' SAVING  data  in  file  ";Filename$;"  on  ";Diskdrive$ 
830  Status$  = "N" 

832  ASSIGN  ©Datapath  TO  Filename$&Diskdrive$ 

834  OUTPUT  @Datapath;Status$ 

836  OUTPUT  @Datapath;Data_id$  140  chrs  description  of  data 

838  OUTPUT  @Datapath;Datacount  Inumber  of  xy  points 

840  OUTPUT  @Datapath;Filesize  Isize  of  array 

842  OUTPUT  @Datapath;File(*) 

844  ASSIGN  ©Datapath  TO  # 

846  OFF  ERROR 

848  1 

850  Mistakeline:OFF  KEY 
852  LOOP 

854  EXIT  IF  TIMEDATE-Dtime >1.8 

856  END  LOOP 

858  DISP  CHR$(1 2) 

860  OUTPUT  2 USING  "#,K";"K" 

862  SUBEXIT 

864  I 

866  ! //////////////////////////////////////////////////////// 

868  I 

870  Cant_savedata:  ! 

872  BEEP  500, .6 

874  SELECT  ERRN 

876  CASE  72,73,76,78,81 ,82,90,93 

878  DISP  Diskdrive$;"  has  failed  or  is  not  available  "; 

880  DISP  " ....CONTINUE  to  try  again." 

882  PAUSE 

884  Diskdrive$  = "" 
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886  CASE  84,85 

888  D!SP  " This  disk  is  not  initialized 

890  DISP  " ....CONTINUE  to  try  again." 

892  PAUSE 

894  Diskdrive$  = "" 

896  CASE  55,64 

898  DISP  " This  disk  is  full,  insert  new  floppy  and/or"; 

900  DISP  " select  new  drive  ...CONTINUE  B 

902  PAUSE 

904  Diskdrive$ 

906  CASE  ELSE 

908  CALL  Errortrap 

910  IF  LEN  (Filename  $)  >0  THEN  GOTO  Send_to  disk 

912  END  SELECT 

914  GOTO  Seiectdrive 

916  I 

918  SUBEND 

920  I 

922  j * 

924  ! 

926  SUB  Menu_scroll(D$,T$,Items$(*UNTEGER  ltem_cnt,To_select,Choose(*)) 
928  Menu  scroll:!  Original:  22  Jun  1987,  Galen  Koepke,  NBS  723.04 
930  I Revision:  06  Aug  1987,  10:00 

932  l 

934  ! A general  purpose  menu  utility  for  scrolling  items  and 

936  f selecting  a given  number  of  them. 

938  I The  items  are  arranged  in  screens  of  1 5 items  each  and 

940  I the  user  may  access  screens  via  softkeys.  There  may  be 

942  ! up  to  10  screens  or  150  items  to  choose  from. 

944  I ltems$(#)  contains  the  item  descriptions 

946  I ltem_cnt  is  the  number  of  items  in  items$(*) 

948  I Choose!*)  is  dimensioned  to  the  number  of  required  choices 

950  I and  will  be  filled  with  the  item  numbers  chosen. 

952  I To_select  is  the  number  of  required  choices. 

954  I 

956  OPTION  BASE  1 

958  PRINTER  IS  CRT 

960  DEG 

962  GOSUB  Def_variables 

964  GOSUB  Define^screens 

966  GOSUB  Make_selections 

968  IF  Null_file  THEN  I reset  to  zero 

970  Itemjcnt^O 

972  ltems$(1)  = 

974  To_select  = 0 I no  valid  selections 

976  END  IF 

978  SUBEXIT 

980  l 

982  I //////////////////////////////////////////////////// 

984  I 

986  Befjvariables:! 

988  COM  /Interrupts/  INTEGER  Intr  prty 

990  COM  /Bugs/  INTEGER  Bug  1 ,Bug2,Bug3, Printer 

992  COM /Sys/ Sysjd$H0| 

994  ! 

996  INTEGER  Screen j;nt,ltems_per_scn,FirstJtem(  10), Last Jtem(IO) 
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998  INTEGER  l,J,KfFirstJine,LastJine,Active_screen,Pointer,Last_pt 
1000  INTEGER  Local_prty, Skips, Knobcount,Pointeractive,KO,Null_file 

1002  INTEGER  Exit  flag 

1004  DIM  Marker$[8],Test$[160] 

1006  I 

1008  I initialize  parameters 

1010  ! 

1012  Local_prty  = lntr_prty 

1014  IF  Local  prty<1  THEN  Local _prty  = 1 0 

1016  IF  LEN(Sys  id$)=0  THEN  Sys_id$  = SYSTEM $(" SYSTEM  ID") 

1018  IF  Item  cnt”<  1 THEN 

1020  Nulljfile  = 1 

1 022  ltem_cnt  = 1 

1024  To  select  = 0 

1026  ltems$(1  ) = "***  Empty  ###" 

1028  ELSE 

1030  Null  file  = 0 

1032  END  IF” 

1034  IF  To  select  > ltem_cnt  THEN  To_select  = ltem_cnt 

1036  Skips”=0 

1038  Knobcount  = 0 

1040  Doneflag  = 0 

1 042  Marker$  = " = = = > "&RPT$(CHR$(8),4) 

1044  RETURN 

1046  I 

1 048  ! Illlllllllllllllllllllllllllllllllllllllllllllllllll 

1050  I 

1052  Define_screens:!  Set  up  screens  of  15  items  each. 

1054  I 

1056  ltems_per_scn  = 1 5 I Maximum  number  of  displayable  items 
1058  IF  INT(ltem_cnt/ltems_per_scn)  = ltem_cnt/ltems_per_scn  THEN 

1060  Screen  cnt  = INT{ltem  cnt/ltems_per_scn) 

1062  ELSE 

1064  Screen  cnt  = INT(ltem  cnt/ltems_per_scn)  + 1 

1066  END  IF 

1068  J = 1 

1070  FOR  1 = 1 TO  Screen_cnt  ! set  up  each  screen 

1072  First_item(l)  = J 

1074  IF  J + ltems_per_scn-1  <ltem_cnt  THEN 

1 076  Lastjtem(l)  = J + ltems_per_scn-1 

1078  J = J + ltems_per=scn 

1080  ELSE 

1 082  Lastjtem(l)  = ltem=cnt 

1084  END  IF~ 

1 086  NEXT  I 

1088  RETURN 

1090  I 

1 092  I /////////////////////////////////////////////////// 

1094  I 

1096  Make_selections:l  MENU  setup  and  use. 

1098  Active__screen  = 1 I first  screen  is  active 

1100  Firstjine  = 2 ! first  printed  line  on  screen  = 2 or  greater. 

1 1 02  GOSUB  Write_screen  I activate  screen  at  Active_screen 

1104  I and  set  Firstjine  and  Last Jine  for  Pointer 

1106  I write  Marker$  to  first  non-selected  line. 

1108  K0  = 0 I Keys  start  at  zero 
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1110  Exit  flag=0  I allow  ENTER  key  to  exit  when  selections  filled. 

1112  IF  Sys_id$[1 ,4]  = "S300"  THEN 

1114  CONTROL  KBD,2;1 

1116  STATUS  KBD,14;J 

1118  IF  J = 0 THEN  I key  1 defined 

1120  KO  = 1 

1 1 22  ELSE  I key  0 defined 

1124  KO  = 0 

1126  END  IF 

1128  ELSE 

1130  KO “0 

1132  END  IF 

1 1 34  Key  loop:  I 

1136  ON  KBDfLocal_prty  GOSUB  Process  Jcbd 
1138  ON  KNOB  .01  .LocaLprty  GOSUB  Move_pointer 
1140  IF  Skips  <To_select  THEN 

1142  DISP  D$ 

1144  IF  To  select  > 1 THEN 

1 1 46  Test$  = B Select  "&VAL$ (Skips  + 1 )&"  of  "&VAL$(Toj»elect) 

1148  ELSE 

1 1 50  Test$  « * Select" 

1152  END  IF 

1154  ON  KEY  KO  LABEL  Test$fLocal_prty  GOSUB  Select Jtem 

1156  ELSE 

1158  IF  To  ^select  > 0 THEN 

1 1 60  DISP  * Selection  process  complete  ..." 

1 1 62  ELSE 

1 1 64  DISP  " Menu  for  information  only  ...  B 

1166  END  IF 

1168  ON  KEY  KO  LABEL  w Accept", Local_prty  GOTO  Exitjine 

1 1 70  END  IF 

1172  IF  Active_screen  < Screen_cnt  THEN 

1174  ON  KEY  KO  + 1 LABEL  " Next  Screen" ,Local_prty  GOSUB  Next_screen 

1176  ELSE 

1178  OFF  KEY  KO  + 1 

1180  END  IF 

1182  IF  Active_screen  > 1 THEN 

1184  ON  KEY  K0  + 2 LABEL  " Last  Screen" #Local_prty  GOSUB  Last_screen 

1186  ELSE 

1188  OFF  KEY  KO  + 2 

1 1 90  END  IF 

1192  IF  Skips  >0  THEN 

1194  ON  KEY  K0  + 3 LABEL  " Reset  Select" f Local jjrty  GOSUB  Select_reset 

1196  ELSE 

1198  OFF  KEY  KO  + 3 

1 200  END  IF 

1 202  IF  To  select  > 0 THEN 

1204  ON  KEY  KO  + 4 LABEL  " Abort  ",Localjjrty  GOTO  Escapejine 

1 206  ELSE 

1208  OFF  KEY  KO  + 4 

1210  END  IF 

1212  IF  Exitjlag  THEN  Exit  line 

1214  GOTO  Key Joop 

1216  EscapeJine:Skips  = 0 
1218  MAT  Choose  » (0) 

1220  To_select  = 0 
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1222  Exit  line:OFF  KEY 
1 224  “OFF  KNOB 

1226  OFF  KBD 

1228  OUTPUT  KBD;CHR$(255)&CHR$(75); 

1230  PRINT  CHR$(1 28); 

1 232  ! everything  cleared,  now  go  back  to  work. 

1 234  RETURN 

1236  I 

1 238  I /////////////////////////////////////////////////// 

1240  I 

1 242  Next  screen:  ! 

1 244  OFF  KBD 

1246  OFF  KNOB 

1248  OFF  KEY 

1250  IF  Active_screen  = Screen_cnt  THEN  RETURN 

1252  Active_screen = Acti  ve_screen  + 1 

1 254  GOSUB  Write_screen 

1256  RETURN 

1258  ! 

1 260  I /////////////////////////////////////////////////// 

1262  ! 

1 264  Last_screen:  ! 

1266  OFF  KBD 

1268  OFF  KNOB 

1270  OFF  KEY 

1272  IF  Active_screen  = 1 THEN  RETURN 

1274  Active_screen = Active_screen- 1 

1 276  GOSUB  Write_screen 

1278  RETURN 

1280  ! 

1 282  I ////////////////////////////////////////////////// 

1284  ! 

1286  Selectjtem:! 

1288  OFF  KBD 

1 290  OFF  KNOB 

1292  OFF  KEY 

1 294  IF  NOT  Pointeractive  THEN 

1296  DISP  "NO  additional  selections  for  this  screen. 

1298  BEEP 

1 300  WAIT  2 

1302  DISP  CHR$(12); 

1 304  RETURN 

1306  END  IF 

1308  IF  Skips  = To_select  THEN 

1310  IF  To_select  = 0 THEN 

1312  DISP  "This  menu  is  for  information  only,"; 

1314  DISP  " no  selection  allowed." 

1316  ELSE 

1318  DISP  "All  selections  have  been  filled,"; 

1320  DISP  " 'Select  Reset'  to  repeat." 

1322  END  IF 

1 324  BEEP 

1 326  WAIT  2 

1328  DISP  CHR$(1 2); 

1330  RETURN 

1332  END  IF 
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1334  Skips  = Skips  + 1 

1 336  Choose(Skips)  = First Jtem(Active_screen)  + Pointer-Firstjine 

1338  PRINT  CHR$(1 29);  ! inverse  video 
1 340  PRINT  TABXY ( 1 0,  Pointer);ltems$  (Choose(Skips)) 

1342  PRINT  CHR$(  128); 

1 344  PRINT  TABXY(  1 .Pointer); 

1 346  SELECT  Pointer 

1 348  CASE  Firstjine 

1350  GOSUS  Pointjorward 

1 352  CASE  Lastjine 

1354  GOSUB  Point_backward 

1 356  CASE  ELSE 

1 358  ! move  forward  unless  it  requires  wrapping  to  beginning. 

1360  IF  Skips-1  >0  THEN  1 check  for  selected  items. 

1362  I - Pointer-First  Jine 

1 364  LOOP 

1366  K - 0 

1368  FOR  J * 1 TO  Skips 

1 370  IF  Firstjtem{Active_screen)  + 1 = Choose(J)  THEN  K = 1 

1372  NEXT  J 

1374  EXIT  IF  K-0 

1376  S^S+1 

1378  IF  I + Firstjine > Lastjine  THEN  K = -1 

1380  EXIT  IF  K---1 

1382  END  LOOP 

1384  IF  K = 0 THEN 

1386  GOSUB  Pointjorward 

1388  ELSE 

1390  GOSUB  Pointjaackward 

1392  END  IF 

1394  ELSE 

1 396  GOSUB  Pointjorward 

1398  END  IF 

1400  END  SELECT 

1 402  RETURN 

1404  I 

1 406  ! ////////////////////////////////////////////////// 

1408  S 

1410  Select_reset:  IClear  Choose  file 

1412  OFF  KBD 

1414  OFF  KNOB 

1416  OFF  KEY 

1418  Skips  = 0 

1420  MAT  Choose  * (0) 

1 422  GOSUB  Write_screen 

1424  RETURN 

1426  ! 

1 428  I ///////////////////////////////////////////////// 

1430  S 

1432  Processjcbd:!  Allow  use  of  arrows  and  enter  key  in  addition  to  soft. 
1434  Test$  = KBD$ 

1436  IF  LEN(TestS)  - 1 AND  Test${1J]<  >CHR$(32)  THEN 

1438  BEEP  80„t„1 

1 440  RETURN 

1 442  END  IF 

1444  IF  Test$|1 ,1J=CHR$(32)  THEN  GOSUB  Pointjorward 
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1446 

1448 

1450 

1452 

1454 

1456 

1458 

1460 

1462 

1464 

1466 

1468 

1470 

1472 

1474 

1476 

1478 


CASE  "E" 

IF  Skips  <To_select  THEN 


CASE  "~VW" 

GOSUB  Point_backward 


CASE  CHR$(255) 


CASE  ELSE 
BEEP  80.,.  1 


CASE  T,T 

GOSUB  Point_forward 


IF  T est $ ( 1 , 1 1 < >CHR$(255)  THEN  RETURN 


SELECT  Test$[2,2] 


GOSUB  Select  item 
ELSE 


Exit  flag  = 1 
END  |f” 


I exit  routine 


I do  nothing 


1480  END  SELECT 

1482  Test$  = 

1484  RETURN 

1486  I 

1 488  ! ////////////////////////////////////////////////// 

1490  ! 

1492  Point_forward:Knobcount  = 5 
1494  GOSUB  Move_pointer 

1496  RETURN 

1498  Point_backward:Knobcount  = -5 
1500  GOSUB  Move_pointer 

1 502  RETURN 

1504  ! 

1 506  I ////////////////////////////////////////////////// 

1508  ! 

1510  Jog_pointer:l  Move  the  selection  pointer  on  the  active  screen. 

1512  I without  regard  to  selected  values 

1514  IF  Knobcount>0  THEN  I Move  forward 

1516  Pointer  = Pointer  + 1 

1518  ELSE  I Move  backward 

1 520  Pointer  = Pointer-1 

1522  END  IF 

1524  IF  Pointer  < Firstjine  THEN  Pointer  = Lastjine 

1526  IF  Pointer > Last Jine  THEN  Pointer  = First  Jine 

1528  RETURN 

1530  I 

1 532  I ///////////////////////////////////////////////////////// 

1534  ! 

1 536  Move_pointer:!  Control  pointer  to  avoid  re-selection  of  items 

1 538  IF  NOT  Pointeractive  THEN  RETURN  ! No  selections  to  be  made. 

1 540  Knobcount  = Knobcount  + KNOBX  + KNOBY 

1542  IF  ABS(Knobcount)  < 4 THEN  RETURN 

1 544  Last_pt  = Pointer 

1 546  GOSUB  Jog_pointer 

1548  IF  Skips  >0  THEN 

1550  LOOP 

1552  J = Pointer-First  line 

1 554  FOR  1=1  TO  Skips 

1 556  IF  First Jtem(Active_screen)  + J = Choose(l)  THEN  J = 999 
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1558 

1560 

1562 

1564 

1566 

1568 

1570 

1572 

1574 

1576 

1578 

1580 

1582 

1584 

1586 

1588 

1590 

1592 

1594 

1596 

1598 

1600 

1602 

1604 

1606 

1608 

1610 

1612 

1614 

1616 

1618 

1620 

1622 

1624 

1626 

1628 

1630 

1632 

1634 

1636 

1638 

1640 

1642 

1644 

1646 

1648 

1650 

1652 

1654 

1656 

1658 

1660 

1662 

1664 

1666 

1668 


NEXT  8 

IF  J = 999  AND  Pointer  = Last_pt  THEN  Pointeractive  = 0 
EXIT  IF  Pointeractive  = 0 

IF  J = 999  THEN  GOSUB  Jog_pointer 
EXIT  IF  J<  >999 
END  LOOP 
END  IF 

Knobcount  = 0 

OUTPUT  KBD;CHR$(255)&CHR${84);  ! Bring  screen  home 
IF  Last_pt  = Lastjine  THEN  PRINT  CHR$«132); 

PRINT  ■ 

IF  Pointeractive  THEN  I Pointer  active 
IF  Pointer  = Last  Jine  THEN 
PRINT  CHR$(132); 

ELSE 

PRINT  CHR$(128); 

END  IF 

PRINT  TABXYd  pPointer);Marker$;CHR$d  28); 

END  IF 
RETURN 

S 

! ////////////////////////////////////////////////// 

S 

Write_screen:!  Write  the  screen  pointed  to  by  Activescreen 
! home  and  clear  screen 

OUTPUT  KBD;CHR$(255)&CHR$(84)&CHR$(255)&CHR$(75); 
Knobcount  = KNOBX  + KNOBY  I Clear  knob  and  keyboard 
Knobcount  = 0 
Test$=KBD$ 

Test$  = 

I 

PRINT  TABXY(1  »FirstJine-1  );CHR$d  32);"  Item  »\  Screen  #"; 

PRINT  USING  "#f2Ds3Af2DP3An,;Active_screeni"  of  ";Screen_cnt;B  ! " 
PRINT  T$;RPT$("  \52-LEN(T$));CHR$d28); 

J = 0 
REPEAT 

IF  J = Last  item(Active_screen)  First  Jtem(Active  screen)  THEN 
PRINT  CHR$0  32); 

PRINT  TABXYd,  First  Jine  + J);RPT$("  B,80) 

ELSE 

PRINT  CHR$(1 28); 

END  IF 

PRINT  TABXY(5,FirstJine  + J); 

PRINT  USING  D3DtA,#";FirstJtem(Active_screen)  + JJ  | B 
IF  Skips  >0  THEN  I make  this  line  inverse  video 
FOR  1 = 1 TO  Skips 

IF  First Jtem(Active_screen)  + J =Choose(l)  THEN 
PRINT  CHR$(1 29); 

END  IF 
NEXT  I 
END  IF 

PRINT  TABXYd  O.FirstJine  + J);ltems$(FirstJtem(Active_screen)  + J) 
J=J  + 1 

UNTIL  J > •=  (LastJtem(Active_screen)-FirstJtem(Active_screen)  + 1 ) 
Lastjine  = LastJtem(Active_screen)-FirstJtem(Active_screen) 

Lastjine  - Lastjine  + First  Jine 
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1670  ! 

1672  ! set  marker  to  first  non-selected  item. 

1674  ! 

1676  Pointeractive =0 

1678  IF  To_select>0  THEN  Pointeractive  = 1 

1680  IF  Skips  >0  AND  Pointeractive  = 1 THEN  I find  first  non-selected  item 

1682  J =0 

1684  LOOP 

1686  Pointer  = First  line+J 

1688  FOR  1 = 1 TO  Skips 

1690  IF  First  item(Active_screen)  + J = Choose (I)  THEN  Pointer =0 

1692  NEXT  I 

1694  EXIT  IF  Pointer <>0 

1696  J=J  + 1 

1698  IF  First Jine  + J > Lastjine  THEN 

1700  Pointeractive  = 0 

1 702  Pointer  = First  Jine 

1 704  END  IF 

1706  EXIT  IF  Pointer <>0 

1 708  END  LOOP 

1710  ELSE 

1712  Pointer  = First  line 

1714  END  IF 

1716  IF  Pointeractive  THEN 

1718  IF  Pointer  = Lastjine  THEN 

1720  PRINT  CHR$(1 32); 

1722  ELSE 

1724  PRINT  CHR$(1 28); 

1726  END  IF 

1 728  PRINT  TABXY(1  ,Pointer);Marker$;CHR$(1 28); 

1730  END  IF 

1732  RETURN 

1734  SUBEND 
1736  ! 

1738  ! *** * 

1740  ! 

1 742  SUB  Errortrap 
1744  Errortrap:  ! Original:  13  Nov  1984 
1746  ! Revision:  06  Aug  1987 

1748  ! Trap  most  disk  errors  here 

1750  COM  /Files/  Diskdrive$[20],Filename$[14]fMs_path$[500] 

1 752  DIM  File$(201,Test$H  60LWhat${20],Ac$[5]  " 

1754  BEEP  400f.6 

1756  SELECT  ERRN 

1758  CASE  54 

1760  DISP  "DUPLICATE  FILE  NAME:  ";Filename$; 

1762  DISP  ’....PURGE  old  one?  (Y/N)"; 

1764  LINPUT  What$ 

1766  What$  =TRIM$(What$) 

1768  SELECT  What$[1,1] 

1770  CASE  "YVy" 

1772  PURGE  Filename$&Diskdrive$ 

1774  CASE  ELSE 

1776  Ac$="  VALID" 

1778  CALL  Enterfilename(Ac$) 

1780  END  SELECT 
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1782  CASE  52,53 

1784  DISP  "Improper  FILE  NAME  — ENTER  NEW  FILE  NAME"; 

1786  OUTPUT  2 USING  "tf,K,K";"#"  ;Filename$ 

1788  LINPUT  Filename$ 

1790  Filename$  =TRIM$(Filename$) 

1792  CASE  56 

1794  DISP  "FILE:  ";Filename$;"  is  not  on  this  disk,  please  insert"; 

1796  DISP  ’ correct  disk" 

1798  PAUSE 

1 800  CASE  64 

1 802  DISP  "This  disk  is  full,  PLEASE  insert  clean  disk" 

1 804  PAUSE 

1806  CASE  56 

1 808  DISP  "DATA  INPUT  disk  must  be  in  drivel!  a; 

1810  DISP  "...CONTINUE  when  ready." 

1812  PAUSE 

1814  CASE  72,73,76 

1816  DISP  Diskdrive$; 

1818  DISP  " is  not  available,  type  correct"; 

1820  DISP  " unit  specifier  (ie.  707,0')."; 

1822  OUTPUT  2 USING  "K,#";Diskdrive$ 

1 824  LINPUT  Diskdrive$ 

1826  CASE  80 

1828  DISP  "CHECK  DISK  drive  door!" 

1830  PAUSE 

1832  CASE  ELSE 

1834  DISP  ERRM$;"  'CONTINUE'  when  fixed" 

1836  PAUSE 

1838  END  SELECT 

1840  DISP  CHR$(1 2) 

1 842  SUBEXIT 

1 844  SUBEND 
1846  ! 

1848  ! ********* * * .*##.#****«> • « * * * * ****** # ********  * 

1850  ! 

1852  SUB  File_menu(Mask$,Ftype$,Fls$(*)„INTEGER  Fls_cnt,Dir  on,Prt_on) 
1 854  File_menu:  ! 

1856  ! Original:  29  Jun  1987,  G.  Koepke 

1858  I Revision:  06  Aug  1987,  10:00 

1860  OPTION  BASE  1 

1862  DEG 

1864  COM  /Sys/  Sysjd$[10I 

1866  COM  /Files/  Diskdrive$[20],Filename$[14],Ms_path$[500] 

1 868  COM  /Interrupts/  INTEGER  lntr_prty 

1870  DIM  Directory$(150H80LBd$(150H71] 

1 872  DIM  D$[80],T$[52],lds$(40],Stat$[1] 

1874  INTEGER  Bd_cnt,File_cnt,l,C_ent,C0(1  ),Format_error 

1876  IF  Fls_cnt>0  THEN  ALLOCATE  INTEGER  Choose(Fls_cnt) 

1878  S 

1 880  ! Catalog  the  disk  specified 

1882  ! 

1884  ON  ERROR  GOTO  Cat_errors 

1886  DISP  " Reading  the  Directory  ...  " 

1 888  MASS  STORAGE  IS  Diskdrive$ 

1890  CAT  TO  Directory$(*);NO  HEADER, COUNT  File_cnt 

1892  OFF  ERROR 
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1894 

1896 

1898 

1900 

1902 

1904 

1906 

1908 

1910 

1912 

1914 

1916 

1918 

1920 

1922 

1924 

1926 

1928 

1930 

1932 

1934 

1936 

1938 

1940 

1942 

1944 

1946 

1948 

1950 

1952 

1954 

1956 

1958 

1960 

1962 

1964 

1966 

1968 

1970 

1972 

1974 

1976 

1978 

1980 

1982 

1984 

1986 

1988 

1990 

1992 

1994 

1996 

1998 

2000 

2002 

2004 


! 

! set  up  array  of  legal  file  names. 

! 

Bd_cnt=0 

FOR  I = 1 TO  File_cnt 

IF  Directory $(lI[32f36]  = Ftype$  THEN  ! Ftype$  = "ASCII  " 

I Ftype$  = "PROG  " 

IF  LEN(Mask$)>0  THEN  I Test  for  mask$ 

IF  Directory$(l)[1,LEN(Mask$)]  = Mask$  THEN 
Bd_cnt  = Bd_cnt  + 1 
Bd$(Bd  cnt)  = Directory  $ (1)11;  101 
END  IF 
ELSE 

Bd_cnt  = Bd_cnt  + 1 
Bd$(Bd_cnt)  = Directory  $(l)[1  ;1 0] 

END  IF 
END  IF 
NEXT  I 
! 

I set  up  file  menu 
I 

D$  = "Select  "&VAL$(Fls_cnt)&"  file  names  for  data  entry." 

T$  = "List  of  "&Ftype$&"liles  on  "&Diskdrive$ 

IF  LEN(Mask$)>0  THEN 
T$=T$&"  mask  = "&Mask$ 

END  IF 

IF  Bd_cnt>0  THEN 

IF  Dir  on>0  THEN  GOSUB  Read_data_id 
IF  Prt~on  THEN 

GOSUB  List  directory 
ELSE 

C cnt  = Fls_cnt 
DISP  CHR$(1 2) 

IF  Fls_cnt  > 0 THEN 

CALL  Menu_scroll(D$,T$,Bd$(*),Bd_cnt,C_cntfChoose(*)) 
ELSE 

CALL  Menu_scroll(D$,T$,Bd$(*),Bdj:nt,C_cnt,CO(*)) 

END  IF 
! 

! transfer  file  names  to  Fls$(*). 

I 

IF  C ent  = 0 THEN  I selection  process  aborted 
MAT  Fls$  = ("") 

ELSE 

MAT  SORT  Choose!*) 

FOR  I = 1 TO  C _cnt 

Fls$(l)  = Bd$(Choose(l))[1  ;1 01 
NEXT  I 
END  IF 
END  IF 
ELSE 

DISP  " This  directory  contains  no  ASCII  files  ...  " 

WAIT  2.5 
END  IF 

DISP  CHR$(1 2) 

SUBEXIT 
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2006  Cat_errors:! 

2008  DISP  "ERROR  ...  ";ERRM$ 

2010  BEEP 

2012  PAUSE 

2014  C ent  - 0 

2016  MAT  Fls$  = (BB) 

2018  SUBEXIT 

2020  ! 

2022  ! //////////////////////////////////////////////////// 

2024  ! 

2026  Read_data  id:  I This  routine  expects  to  see  lds$  from 
2028  T GRAPHED  AT A raw  data  files. 

2030  DISP  ’ Reading  file  contents  ...  " 

2032  FOR  I = 1 TO  Bd_cnt  ! each  ASCII  file 

2034  lds$-”Data  not  recognized." 

2036  ON  ERROR  GOTO  Not_recognized 

2038  ASSIGN  @lo_path  TO  Bd$(l)[1;10] 

2040  ENTER  @lo  path,Stat$ 

2042  SELECT  Stal$ 

2044  CASE  "N" 

2046  ENTER  @lo„path;lds$ 

2048  CASE  °YB 

2050  lds$ -"Complete  graph  ...  use  GRAPH  DATA." 

2062  END  SELECT 

2054  Notj’ecognizedrASSIGN  @lo_path  TO  * 

2056  OFF  ERROR 

2058  IF  Dir_on-2  THEN 

2060  GOSUB  InterpretJ 

2062  IF  Format_error  THEN  GOTO  Otherformat 

2064  GOTO  Go_on 

2066  END  IF 

2068  Otherjormat:! 

2070  Bd$(IH1 1 ,71]  = " ...  "&lds$ 

2072  Go_on:NEXT  \ 

2074  RETURN 

2076  ! 

2078  I /////////////////////////////////////////////////// 

2080  l 

2082  Interpret^!  This  is  used  to  interpret  TEM  program  ID  strings. 

2084  Format^error  - 0 

2086  I identify  this  particular  format 

2088  IF  LEN(lds$)  <40  THEN 

2090  Format_error  s 1 

2092  RETURN 

2094  END  IF 

2096  IF  lds$|40]  o’5*"  THEN 

2098  Format_error  = 1 

2100  RETURN 

2102  END  IF 

2104  I make  the  information  readable 

2106  Bd$(l)(1 1,15]-"  ...  " 

2108  Bd$(l)[1 6,25]  = lds$(1 ,10] 

2110  Bd$(l)[26,32]  = "&lds$[1 1,12]&":“&lds${13,14] 

2112  8d$(l)[33,42]  = ",  "&lds$[1 5,1 6]&"  "&lds$|1 7,1 8]&"  B&lds$[19,20] 

2114  Bd$(l)[43,55]  = ",  "&lds$(21 ,27]&"  MHz" 

2116  Bd$(l)[56,65]  = ",  "&lds$[28,33]&"vm" 
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2118  Bd$(l)[66,71]  = \"&lds$[38,39] 

2120  RETURN 

2122  ! 

2124  ! /////////////////////////////////////////////////// 

2126  1 

2128  List_directory:  I This  routine  will  provide  a tabular  listing  of 
2130  I the  directory  along  with  lds$  if  provided 

2132  ! 

2134  DISP  ' Listing  directory  ...  " 

2136  PRINTER  IS  PRT 

2138  PRINT  USING  "//" 

2140  PRINT  T$ 

2142  PRINT  RPT$("-", 80) 

2144  PRINT  "File  name"; 

2146  IF  Dir_on  THEN 

2148  PRINT  ’ ...  contents" 

2150  ELSE 

2152  PRINT 

2154  END  IF 

2156  PRINT  RPT$("-",80) 

2158  FOR  1-1  TO  Bd  cnt 

2160  PRINT  Bd$(l)~ 

2162  NEXT  I 

2164  PRINT  RPT$("_", 80} 

2166  PRINT 

2168  PRINTER  IS  CRT 

2170  RETURN 

2172  SUBEND 

2174  I 

2176  1 

2178  I 

2180  SUB  Read_data 
2182  ! 

21 84  Read_data:  ! 

2186  I 

2188  OPTION  BASE  1 

2190  RAD 

2192  ! 

2194  COM  /Sy s/  Sy s Jd  $ (1 0] 

2196  COM  /Sys_msi/  Msi_id$[20] 

2198  COM  /Interrupts/  INTEGER  lntr_prty  ' 

2200  COM  /Files/  Diskdrive$[20],Filename$l14],Ms_path$[500] 

2202  ! 

2204  INTEGER  Local_prty,Diskspaee,Fls_cnt 

2206  DIM  Ac$(5],Tempfile$[10],Mask${101,Ftype$[5],Fls$(1  )(10] 

2208  DIM  Data  id$[40] 

2210  REAL  Dtime 

2212  OFF  KEY 

2214  Local  jjrty  = lntr_prty 

2216  Dtime  = 0. 

2218  Filename  $ ~"K 

2220  Diskdrive$  = "" 

2222  ! 

2224  ! 

2226  ISelect  the  disk  drive  where  the  data  exists 

2228  I 
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2230  IF  Overflow  < > 0 THEN  Overflow  = 0 
2232  Hold_size  = Q 

2234  Dtime  = 0. 

2236  Allocated  = 0 

2238  Selectdrive:  I 

2240  IF  Diskdrive  $ = "NO  DISK"  THEN  Diskdrive$  = "" 

2242  IF  LEN (Diskdrive $ ) > 0 THEN  GOTO  Choosefilename 

2244  GRAPHICS  OFF 

2246  OUTPUT  2 USING  "#,K";"K" 

2248  CALL  Selectjiisk 

2250  IF  Diskdrive$”="NO  DISK"  THEN  GOTO  Mistakelineset 

2252  Choosefilename:  1 

2254  Tempfile$  =Filename$ 

2256  IF  LEN(Filename$)  >0  THEN  GOTO  Bringjn_data 
2258  Ac$  = "CAT" 

2260  CALL  Enterfilename(Ac$) 

2262  IF  LEN(Filename$)  = 0 OR  POS(Filename$,"*")>  1 THEN 
2264  SF  POS(Filename$t"*")>  1 THEN  I set  mask$ 

2266  Mask$  = Filename$[1  ,POS(Filename$,"  * ")-1  ] 

2268  Filenames  = "" 

2270  ELSE 

2272  MaskS -”"l  no  preselection 

2274  END  SF 

2276  FtypeS -"ASCII"  S examine  ASCII  files  only 

2278  Flscnt  - 1 ! select  one  file 

2280  Intrjjrty  = Local_prty  + 1 

2282  CALL  File_menu(Mask$,Ftype$,Fls$(#),Fls_cnteO,0| 

2284  lntr_prty  = Local_prty 

2286  Filename$  — Fls$<  1 ) 

2288  IF  LEN(Filename$)  =0  THEN  I aborted 

2290  Filename$  =Tempfile$ 

2292  GOTO  Mistakelineset 

2294  END  IF 

2296  END  IF 

2298  BringJnjjata:  I 
2300  ! 

2302  IFind  this  file  on  the  disk. 

2304  I 

2306  ON  ERROR  GOTO  Cantjindfile 

2308  ASSIGN  ©Datapath  TO  Filename$&Diskdrive$ 

2310  OFF  ERROR 

2312  Dtime  = TIMEDATE 

2314  DISP  " LOADING  disk  file:  ";Filename$f  ... 

2316  ENTER  @Datapath;Data_id$ 

2318  I 

2320  ENTER  @Datapath;Datacount 

2322  SF  NOT  Allocated  THEN 

2324  IF  Datacount>  =1  THEN 

2326  ALLOCATE  HoldingJile$(Datacount)[80) 

2328  ELSE 

2330  ALLOCATE  Holding Jile$(1  ){801 

2332  END  IF 

2334  Allocated  = 1 

2336  END  IF 

2338  ENTER  @Datapath;HoldingJile$D 

2340  ASSIGN  ©Datapath  TO  * 
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2342  OFF  ERROR 

2344  IF  Datacount  = 0 THEN  Mistakeline 

2346  PRINTER  IS  PRT 

2348  FOR  I = 1 TO  Datacount 

2350  PRINT  Holding_file$(l) 

2352  NEXT  I 

2354  PRINTER  IS  CRT 

2356  I 

2358  Overflow  = Hold_size 

2360  GOTO  Mistakeiine 

2362  I 

2364  Mistakelineset:Datacount  = 0 
2366  MistakelinerOFF  KEY 

2368!  IF  Allocated  THEN  DEALLOCATE  Holding_file$ ( * ) 

2370  LOOP 

2372  EXIT  IF  TIMEDATE-Dtime  > 1 .8 

2374  END  LOOP 

2376  DISP  CHR$(1 2) 

2378  OUTPUT  2 USING  "#,K";"K" 

2380  SUBEXIT 

2382  I 

2384  I //////////////////////////////////////////////////////// 

2386  I 

2388  Cant  findfile:  lError  in  searching  for  the  file. 

2390  BEEP  500,.6 

2392  SELECT  ERRN 

2394  CASE  56 

2396  DISP  "That  file  does  not  exist  on  this  disk  "; 

2398  CASE  72,73,76,82 

2400  DISP  Diskdrive$;”  has  failed  or  is  not  available 

2402  CASE  ELSE 

2404  DISP  ERRM$; 

2406  END  SELECT 

2408  DISP  " ....CONTINUE  to  try  again." 

2410  PAUSE 

2412  Filename$  = "" 

2414  Diskdrive$  - 

2416  GOTO  Selectdrive 

2418  I 

2420  RETURN 

2422  ! 

2424  SUBEND 
2426  ! 

2428  }****#*<>*’**®***##**##*#**e**#*****#*#e**#*#*®'**##**#**#*##*#*******#*** 
2430  ! 

2432  SUB  Enterfilename(Ac$) 

2434  Enterfilename:  ! Original:  13  Nov  1984 

2436  I Revision:  10  Dec  1990  includes  HFS  directories 

2438  OPTION  BASE  1 

2440  COM  /Files/  Diskdrive$(20],Filename$l14],Ms_path$[5001 

2442  COM  /Interrupts/  INTEGER  lntr_prty 

2444  INTEGER  l,Ascii_num,Maskflag,Namelength 

2446  DIM  Test$[256],Hfs_temp$[1 61] 

2448  Namelength  = 10 

2450  IF  LEN(Ms_path$)>0  THEN  OUTPUT  KBD  USING  "K,#"  ;"#"&Ms_path$8TH" 

2452  DISP  " ENTER  HFS  directory  PATH  (no  file)"; 
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2454 

2456 

2458 

2460 

2462 

2464 

2466 

2468 

2470 

2472 

2474 

2476 

2478 

2480 

2482 

2484 

2486 

2488 

2490 

2492 

2494 

2496 

2498 

2500 

2502 

2504 

2506 

2508 

2510 

2512 

2514 

2516 

2518 

2520 

2522 

2524 

2526 

2528 

2530 

2532 

2534 

2536 

2538 

2540 

2542 

2544 

2546 

2548 

2550 

2552 

2554 

2556 

2558 

2560 

2562 

2564 


IF  Ac$  < > "PATH"  THEN 

DISP  ",  ENTER  / for  NFS  ROOT  or  null  for  LIF..."; 

END  IF 

LINPUT  Hfs_temp$ 

Hfs_temp$  =TRIM$(Hfs_temp$) 

IF  LEN(Hfs_temp$)  >0  THEN 

IF  LEN(Hfs„temp$)>1  AND  Hfsjemp$[LEN(Hfsjemp$);1] < >7"  THEN 
Hfs_temp$  = Hfs_temp$&"r 
END  IF 

IF  LEN(Hfs_temp$)  - 1 THEN  HfsjempS  = "• 

Namelength  = 14 
END  IF 

IF  Ac$  = "PATH"  THEN 
Ms  paths  = Hfs  tempS 
SUBEXIT 
END  IF 

IF  LEN(Filename$)>0  THEN  OUTPUT  KBD  USING  BK,/5?";B#"&Filename$&"H 
Efnr  ! 

DISP  " ENTER  the  FILE  NAME  ... 

SELECT  Ac$ 

CASE  “CAT” 

DISP  " (ENTER  CAT  mask*  or  ENTER  null  to  CAT)”; 

CASE  "ABORT" 

DISP  "(ENTER  null  to  ABORT) 

CASE  "VALID" 

DISP  "(must  be  a VALID  namel) 

END  SELECT 
LINPUT  Test$ 

TestS  = TRIMS  (TestS) 

IF  LEN(Test$)  = 0 AND  Ac$  = "VALID"  THEN  GOTO  Enterfilename 
IF  LEN(Test$)  =0  THEN  Abortline 
IF  LEN(Test$)>  Namelength  THEN 
BEEP 

DISP  "ERROR  in  NAME  ENTRY  - max  ";Namelength;"  chars,  you  have 
DISP  LEN(TestS);"  ° 

WAIT  1 .8 

OUTPUT  2 USING  "K,#";"#"  &Test$&"H" 

GOTO  Efn 
END  IF 

IF  POS(TestS,"*")>  1 THEN 

Test$  =Test$[1  ,POS(Test$,"  *")-1 1 
Maskf  lag  = 1 
ELSE 

Maskf  lag  = 0 
END  IF 

FOR  1 = 1 TO  LEN (Test$) 

Ascii_num  = NUM(Test$ll|) 

SELECT  Ascii_num 

CASE  65  TO  90,95,97  TO  122,48  TO  57 
(Allowed  characters 
CASE  ELSE 
BEEP 

DISP  "ERROR  in  NAME  ENTRY-ILLEGAL  CHARACTERS,  TRY  AGAIN. 
WAIT  1.8 

OUTPUT  2 USING  "K,#";"#"  &Test$&BH" 

GOTO  Efn 


B252 


2566  END  SELECT 

2568  NEXT  I 

2570  IF  Maskflag  THEN 

2572  Filename  $ =Test$&"*" 

2574  ELSE 

2576  Filename  $ =Test$ 

2578  END  IF 

2580  Ms  path$=Hfs  temp$ 

2582  SUBEXIT 

2584  Abortline:Filename$  =*"" 

2586  IF  Ac$  ="CAT"  THEN  Ms_path$  =Hfs_temp$ 

2588  SUBEXIT 

2590  SUBEND 
2592  I 

2594  ! # 

2596  ! 
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